Need help searching entire workbook and not just a single sheet

[scubadivingfool]

Hello All

I need help modifying the code below to look through the entire workbook searching for "$" instead of just one. I would love it if it could just search for CGYSR-"##". I have had help putting the code together as I am new to VBA

Here is the code:

Option Explicit

Sub FindPriceTagInformation()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Fill in the search Value
MyArr = Array("$")

Set NewSh = Sheets("Sheet2")

With Sheets("CGYSR-3").Range("A1:ZZ300")

Rcount = 0

For I = LBound(MyArr) To UBound(MyArr)


Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
NewSh.Cells(Rcount, 3).Value = Rng.Value

NewSh.Cells(Rcount, 2).Value = Rng.Offset(-3, 0).Value
NewSh.Cells(Rcount, 1).Value = Rng.Offset(-5, 0).Value

Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[svendiamond]

Can you try something like this?

Option Explicit

Sub FindPriceTagInformation()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet

Dim ws As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Fill in the search Value
MyArr = Array("$")

Set NewSh = Sheets("Sheet2")



For Each ws In ThisWorkbook.Worksheets

    If Left(ws.Name, 7) = "CGYSR-3" Then

        With ws.Range("A1:ZZ300")
            
            Rcount = 0
            
            For I = LBound(MyArr) To UBound(MyArr)
            
                
                Set Rng = .Find(What:=MyArr(I), _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlPart, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
                
                If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                Rcount = Rcount + 1
                NewSh.Cells(Rcount, 3).Value = Rng.Value
                
                NewSh.Cells(Rcount, 2).Value = Rng.Offset(-3, 0).Value
                NewSh.Cells(Rcount, 1).Value = Rng.Offset(-5, 0).Value
                
                Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
                End If
            Next I
            
        End With
        
    End If
Next ws

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub