Consulting

Results 1 to 2 of 2

Thread: Macro to search for string in multiple worksheets and display results

  1. #1
    VBAX Newbie
    Joined
    Apr 2012
    Posts
    1
    Location

    Macro to search for string in multiple worksheets and display results

    Hello,

    I'm just a beginner at VBA and need help to build a macro to search for values (unique ID) from 1 workbook containing one worksheet in another workbook containing 8 worksheets and then display the result in the first workbook.

    I would like the macro to run in a file called 'G_W_P.xlsx' that contains a unique ID string (e.g. CBX246) in Column A only. Column A has approximately 400 rows.

    The macro would need to look at Row 2 in Column A of this workbook ('G_W_P.xlsx') and search for the unique ID fom that cell within Column A of eight different sheets of a second workbook file called 'G&W - S&C.xlsx'.

    I would like the macro to display the worksheet(s) from 'G&W - S&C.xlsx' where the unique ID was found in Column B, C, D etc. of 'G_W_P.clsx' next to the unique ID that was searched for.

    The macro would then repeat the process for all rows within the first workbook ('G_W_P.xlsx').

    Could someone tell me if this is possible and how hard it would be to code?

    Many thanks,
    Tim.

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,209
    Location
    Welcome to the forum

    You could try something like this... but there may be a much faster way using "Find".

    This might help though.
    [VBA]Sub Example()
    Dim rCell As Range, pCell As Range, ws As Worksheet, x As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Workbooks.Open Filename:="C:\B.xlsx"

    With ThisWorkbook.Sheets(1)
    For Each rCell In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Cells
    x = 0
    For Each ws In Workbooks("B.xlsx").Worksheets
    For Each pCell In ws.Range("A2:A" & ws.Range("A" & Rows.Count).End(xlUp).Row).Cells
    If UCase(pCell.Value) = UCase(rCell.Value) Then
    x = x + 1
    rCell.Offset(, x).Value = pCell.Worksheet.Name & " " & Replace(pCell.Address, "$", "")
    End If
    Next pCell
    Next ws
    Next rCell
    End With

    Workbooks("B.xlsx").Close False

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    End Sub[/VBA]

    Hope this helps
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2404, Build 17531.20128

Posting Permissions

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