Results 1 to 8 of 8

Thread: Fetch Data from multiple sheets based on criteria VBA

  1. #1
    Junior Member
    Join Date
    May 2011
    Posts
    7
    Rep Power
    0

    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
    Last edited by Raj Kumar; 03-01-2012 at 12:43 PM.

  2. #2
    Junior Member
    Join Date
    May 2011
    Posts
    7
    Rep Power
    0
    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

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi Raj,

    Please find the attachment.
    Attached Files Attached Files
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  5. #5
    Junior Member
    Join Date
    May 2011
    Posts
    7
    Rep Power
    0
    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.

  6. #6
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    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) & """)))")
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  7. #7
    Junior Member
    Join Date
    May 2011
    Posts
    7
    Rep Power
    0
    Admin, awesome.... it works great.

    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

  8. #8
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    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) & """}"
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Replies: 8
    Last Post: 06-08-2013, 01:24 PM
  2. Sum values based on multiple criteria
    By Jorrg1 in forum Excel Help
    Replies: 8
    Last Post: 01-07-2013, 03:04 PM
  3. Sum values based on multiple criteria
    By vmath in forum Excel Help
    Replies: 1
    Last Post: 05-07-2012, 08:53 AM
  4. Fetch multiple values based on criteria
    By Lucero in forum Excel Help
    Replies: 8
    Last Post: 04-07-2012, 12:35 PM
  5. Printing Sheets Based On Criteria VBA
    By excel_learner in forum Excel Help
    Replies: 1
    Last Post: 05-04-2011, 08:00 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •