Fetch Data from multiple sheets based on criteria VBA

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

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

1 Attachment(s)

Hi Raj,

Please find the attachment.

Hi Raj,

Try this. Assign this macro on a button.

Code:

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

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.

Hi,

Replace this

Code:

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

with

Code:

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

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 :)

Hi,

Replace

Code:

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

with

Code:

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) & """}"