Need help searching entire workbook and not just a single sheet - excel

Question

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

Answer 1

Please, try the next adapted code:
Sub FindPriceTagInformation()
Dim FirstAddress As String, MyArr, Rng As Range, Rcount As Long, I As Long
Dim ws As Worksheet, NewSh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the search Value
MyArr = Array("$")
Set NewSh = Sheets("Sheet2")
Rcount = 0
For Each ws In ActiveWorkbook.Sheets
If left(ws.Name, 6) = "CGYSR-" Then
With ws.Range("A1:ZZ300")
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

Answer 2

Searching in Worksheets
In the workbook containing this code (ThisWorkbook), loops through each worksheet trying to identify the ones whose name starts with a given string (CGYSR-). Then it searches for a $ identifying cells with prices and retrieves these cell's values and the values of two other associated cells (3 and 5 cells above) and writes them to a row in another worksheet (Sheet2).
Option Explicit
Sub FindPriceTagInformation()
Const swsNameBegin As String = "CGYSR-"
Const srgAddress As String = "A1:ZZ300"
Const dwsName As String = "Sheet2"
Dim SearchStrings As Variant: SearchStrings = Array("$")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Destination Worksheet
Dim dws As Worksheet: Set dws = wb.Worksheets(dwsName)
' You do it once here, so you don't have to do it many times in the loops.
Dim sCellsCount As Long: sCellsCount = dws.Range(srgAddress).Cells.Count
Dim npLen As String: npLen = Len(swsNameBegin)
Dim ssLower As Long: ssLower = LBound(SearchStrings)
Dim ssUpper As Long: ssUpper = UBound(SearchStrings)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Dim sws As Worksheet ' Source Worksheet
Dim srg As Range ' Srouce Range
Dim sfCell As Range ' Source Found Cell
Dim slCell As Range ' Source Last Cell
Dim dr As Long ' Current Destination Row
Dim ss As Long ' Current Search String
Dim FirstAddress As String
For Each sws In wb.Worksheets
' A 'begins-with' ('Left') comparison where 'StrComp' will return 0 if
' the strings are equal. Combined with 'vbTextCompare', it will
' ignore case i.e. 'CG=cg'.
If StrComp(Left(sws.Name, npLen), swsNameBegin, vbTextCompare) = 0 Then
Set srg = sws.Range(srgAddress)
Set slCell = srg.Cells(sCellsCount) ' the same for all strings
For ss = ssLower To ssUpper
Set sfCell = srg.Find( _
What:=SearchStrings(ss), _
After:=slCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows)
If Not sfCell Is Nothing Then ' string was found
FirstAddress = sfCell.Address ' to prevent an endless loop
Do
' Write to the Destination Worksheet.
dr = dr + 1
dws.Cells(dr, 3).Value = sfCell.Value
dws.Cells(dr, 2).Value = sfCell.Offset(-3, 0).Value
dws.Cells(dr, 1).Value = sfCell.Offset(-5, 0).Value
' Find next string.
Set sfCell = srg.FindNext(sfCell)
' Note that in this case, 'sfCell' will never ever
' be 'Nothing' once it's 'something'. The 'Find' method
' doesn't 'know' where it found the first: it just finds
' the next even if it's the same (it goes round and round)
' i.e. if there is one cell to find,
' it will find it 'forever'.
' That's the reason behind comparing with the first address.
Loop While sfCell.Address <> FirstAddress
Set sfCell = Nothing ' reset for the next string
'Else ' string was not found
End If
Next ss
End If
Next sws
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Inform: useful for short and long operations.
MsgBox "Retrieved price tag information.", vbInformation
End Sub