Try this...
Code:Private Sub CommandButton1_Click() Dim varCriteria As Variant Dim varIndex As Variant Dim lngElements As Long lngElements = Abs(Me.txtNo.Value <> "") + Abs(Me.txtName.Value <> "") + Abs(Me.txtParts.Value <> "") ReDim varCriteria(1 To lngElements) ReDim varIndex(1 To lngElements) lngElements = 0 If Me.txtNo.Value <> "" Then lngElements = lngElements + 1 varCriteria(lngElements) = Me.txtNo.Value varIndex(lngElements) = 1 End If If Me.txtName.Value <> "" Then lngElements = lngElements + 1 varCriteria(lngElements) = Me.txtName.Value varIndex(lngElements) = 2 End If If Me.txtParts.Value <> "" Then lngElements = lngElements + 1 varCriteria(lngElements) = Me.txtParts.Value varIndex(lngElements) = 3 End If Consolidator varCriteria, varIndex, Worksheets(Me.cmbSearchName.Value) End Sub Function Consolidator(varCriteria As Variant, varIndex As Variant, wks As Worksheet) Dim varSource As Variant Dim lngElements As Long Dim lngRows As Long Dim blnValid As Boolean Dim varOutput As Variant Dim lngCounter As Long With wks varSource = .Range("B4:G" & .Cells(Rows.Count, 2).End(xlUp).Row) End With ReDim varOutput(1 To UBound(varSource), 1 To UBound(varSource, 2)) For lngRows = LBound(varSource) To UBound(varSource) For lngElements = LBound(varCriteria) To UBound(varCriteria) If UCase(varSource(lngRows, varIndex(lngElements))) = UCase(varCriteria(lngElements)) Then blnValid = True Else blnValid = False Exit For End If Next lngElements If blnValid Then lngCounter = lngCounter + 1 For lngElements = 1 To UBound(varSource, 2) varOutput(lngCounter, lngElements) = varSource(lngRows, lngElements) Next lngElements End If Next lngRows With Worksheets("Main") .Range("B21:G" & .Cells(Rows.Count, 2).End(xlUp).Row + 2).ClearContents .Range("B21").Resize(UBound(varOutput), UBound(varOutput, 2)).Value = varOutput End With End Function




Reply With Quote
Bookmarks