Fetch Data from multiple sheets based on criteria VBA

[Raj Kumar]

Hello Excelfox community,

No I again need a help in Excel.

There are 7 sheets in my workbook. Sheet1 to Sheet6 contains data. 7th sheet is called "Find".

I have placed a text box field in 'Find' sheet, which allowed multiline with enterkeybehaviour. So user can enter multiple lines. What I am trying to do is,

There is a combo box which contains only 2 items, "Purchase", "Sales".

If user select "Purchase" need to SEARCH the entries entered in text box (multiline) in Sheet3 & Sheet4 column_F, If user enter 10 lines, needs to look for these 10 items. If found anything, then copy all the found rows data (Sheet3!A:G, Sheet4!A:G) in the find sheet. If possible to SORT by column B. Sound like "Merge found records from two sheets in to a single sheet"

Also if possible enter a sheet name where these records found in the last column in 'Find' sheet. eg: in Col_H if ThisRow item found in Shee3, label as Sheet3, if from Sheet4 label as Sheet4

If user select "Sales" need to SEARCH the entries entered in text box (multiline) only in Sheet4 column_F, If found anything, then copy all the found rows data (A:L) in the find sheet. If possible to SORT by column B

In Sheet3, 4 & 5 data starts from Row 7 to down. So needs to look it for dynamically. also in 'Find' sheet data to be placed in row 7 to down.

I really appreciate your assistance

Raj

[Raj Kumar]

Thank you Admin for this works great.

Is it possible to SEARCH for text box entries, instead of it's actual values = sheets.

eg: if i enter:

231, xt249, text120, text

Search for these items in column_F then copy rows to Find sheet. Same like ISNUMBER(SEARCH(txtbox.value,InSheets)) also keep the source format?

Instead of Private Sub ComboBox1_Change(), possible to make it as SUB for a button. So users can select the sheets, enter textbox entries then can click on the button.

Thanks ton again for your help

[Admin]

Hi Raj,

Please find the attachment.

[Admin]

Hi Raj,

Try this. Assign this macro on a button.


Sub SearchData()

Dim strComboSelection As String
Dim lngIndex As Long, c As Long
Dim ShtsPuchase, ShtSales As String
Dim ka, k(), i As Long, n As Long
Dim x, j As Long, r As Long
Dim m As Long, SearchKeys As String


ShtsPuchase = Array("Sheet3", "Sheet4") '<< adjust sheet names
ShtSales = "Sheet5" '<< adjust sheet names

SearchKeys = Worksheets("find").TextBox1.Value
If Len(SearchKeys) Then
SearchKeys = "{""" & Replace(Replace(SearchKeys, Chr(10), """;"""), Chr(13), vbNullString) & """}"
With Worksheets("find").ComboBox1
lngIndex = .ListIndex
strComboSelection = LCase$(.List(lngIndex, 0))
End With

Select Case strComboSelection
Case "purchase"
ReDim k(1 To 1000, 1 To 8)
n = 1
For j = LBound(ShtsPuchase) To UBound(ShtsPuchase)
With Worksheets(ShtsPuchase(j))
r = .Range("a" & .Rows.Count).End(xlUp).Row
ka = .Range("a7:g" & r)
End With
For c = 1 To UBound(ka, 2): k(1, c) = ka(1, c): Next: k(1, c) = "Label"
For i = 2 To UBound(ka, 1)
x = False
x = Evaluate("isnumber(lookup(9.9999e+307,search(""" & ka(i, 6) & """," & SearchKeys & ")))")
If x Then
n = n + 1
For c = 1 To UBound(ka, 2)
k(n, c) = ka(i, c)
Next: k(n, c) = ShtsPuchase(j)
End If
Next
Erase ka
Next
Case "sales"
ReDim k(1 To 1000, 1 To 12)
n = 1
With Worksheets(ShtSales)
r = .Range("a" & .Rows.Count).End(xlUp).Row
ka = .Range("a7:l" & r)
End With
For c = 1 To UBound(ka, 2): k(1, c) = ka(1, c): Next
For i = 2 To UBound(ka, 1)
x = False
x = Evaluate("isnumber(lookup(9.9999e+307,search(""" & ka(i, 6) & """," & SearchKeys & ")))")
If x Then
n = n + 1
For c = 1 To UBound(ka, 2)
k(n, c) = ka(i, c)
Next
End If
Next
End Select

If n Then
Application.ScreenUpdating = False
With Worksheets("Find")
.Range("a7", .Cells(7, 1).SpecialCells(11)).ClearContents
With .Range("a7").Resize(n, UBound(k, 2))
.Value = k
.Sort .Cells(2, 2), 1, Header:=1
.EntireColumn.AutoFit
End With
End With
Else
MsgBox "No records found", vbInformation
With Worksheets("Find")
.Range("a7", .Cells(7, 1).SpecialCells(11)).ClearContents
End With
End If
Application.ScreenUpdating = True
End If

End Sub

[Raj Kumar]

Thank you for this Admin.

I am sorry, this still doesn't search like a wildcard. May be I haven't been explained clearly.

Eg: The below are the entries in text box multiline. Combo selection "Purchase"

text710, 313, xt116, 27, 1702

You can see these values found in Sheet3!F21, Sheet3!F29, Sheet4!F18, Sheet3!F12 & Sheet4!F16 for the first 4 items. The last one doesn't found in two sheets. So I like to copy these rows data to Find.

Same like Find command with CTRL+F

Thank you for your assistance Admin.

[Admin]

Hi,

Replace this


x = Evaluate("isnumber(lookup(9.9999e+307,search(""" & ka(i, 6) & """," & SearchKeys & ")))")

with


x = Evaluate("isnumber(lookup(9.9999e+307,search(" & SearchKeys & ",""" & ka(i, 6) & """)))")

[Raj Kumar]

Admin, awesome.... it works great. :notworthy:

One last question.

Some time user leave just enter key in text box, so it produce a wrong result. Is it possible to check If(LEN(TRIM(textbox1))>0 in SearchKeys

eg: user enter 10 lines. But there may be only 8 or 9 entries. Rest of them they just hit ENTER key: no entries, So CHAR(10) is there. So TRIM the textbox & take only LEN()>1 as SearchKeys

Thank you for your time :)

[Admin]

Hi,

Replace


SearchKeys = "{""" & Replace(Replace(SearchKeys, Chr(10), """;"""), Chr(13), vbNullString) & """}"

with


x = Split(SearchKeys, Chr(10))
SearchKeys = vbNullString
For j = 0 To UBound(x)
If Len(Trim$(Replace(x(j), Chr(13), vbNullString))) Then
SearchKeys = SearchKeys & """;""" & Trim$(Replace(x(j), Chr(13), vbNullString))
End If
Next
SearchKeys = "{""" & Mid$(SearchKeys, 4) & """}"