counting results from searchareas.

[User103]

I'm recently new to vba and excel and found on this site a piece of code that works great for what I need it to do, which is search my worksheets for any criteria I need then highlight it. Only problem is it does not tell me how many times that result appears. I have a monthly process where I list all new listings, anybody in the house can add the listing. I keep 36 months worth of spread sheets (36 total sheets). I need the search to look for the current month and the criteria I'm looking for then come back and tell me how many times in that month it appears. Below is the code I found that needs to be tweaked a little. Any and all help would be greatly appreciated.

[VBA]
[ Private Sub SearchAreas_Click()
Dim ThisAddress$, Found, FirstAddress
Dim Lost$, N&, NextSheet&
Dim CurrentArea As Range, SelectedRegion As Range
Dim Reply As VbMsgBoxResult
Dim FirstSheet As Worksheet
Dim Ws As Worksheet
Dim Wks As Worksheet
Dim Sht As Worksheet

Set FirstSheet = ActiveSheet '< bookmark start sheet
Lost = InputBox(prompt:="What are you looking for?", _
Title:="Find what?", Default:="*")
If Lost = Empty Then End
For Each Ws In Worksheets
Ws.Select
With ActiveSheet.Cells
Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
If FirstAddress Is Nothing Then '< blank sheet
GoTo NextSheet
End If
FirstAddress.CurrentRegion.Select
Selection.Interior.ColorIndex = 6 '< yellow
'//colour the 'Lost' font red, cell colour blank
With Selection
Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
Found.Interior.ColorIndex = 3 '< red
Found.Font.Bold = True
Found.Font.ColorIndex = 2
Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found. _
Address <> FirstAddress
End If
End With
Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
vbQuestion + vbYesNoCancel, "Current Region")
'//restore the 'Lost' font and cell colour
Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
Found.Font.Bold = False
Found.Font.ColorIndex = 0
Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found. _
Address <> FirstAddress
End If
'//restore the selection colour
Selection.Interior.ColorIndex = xlNone
Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
If Reply = vbCancel Then End
'//dont look further
If Reply = vbYes Then
Set SelectedRegion = Selection
GoTo Finish:
End If
'//case=not this one
ThisAddress = FirstAddress.Address
Set CurrentArea = Selection
Do
If Intersect(CurrentArea, Selection) Is Nothing Then
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
'//colour the 'Lost' font red, cell colour blank
With Selection
Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
Found.Interior.ColorIndex = 3
Found.Font.Bold = True
Found.Font.ColorIndex = 2
Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found. _
Address <> FirstAddress
End If
End With
Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
vbQuestion + vbYesNoCancel, "Current Region")
'//restore the 'Lost' font and cell colour
Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
Found.Font.Bold = False
Found.Font.ColorIndex = 0
Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found. _
Address <> FirstAddress
End If
'//restore the selection colour
Selection.Interior.ColorIndex = xlNone
Set FirstAddress = .Find(What:=Lost, _
LookIn:=xlValues)
If Reply = vbCancel Then End
If Reply = vbYes Then
Set SelectedRegion = Selection
GoTo Finish:
End If
End If
If CurrentArea Is Nothing Then
Set CurrentArea = Selection
Else
Set CurrentArea = Union(CurrentArea, Selection)
End If
Set FirstAddress = .FindNext(FirstAddress)
FirstAddress.CurrentRegion.Select
Loop While Not FirstAddress Is Nothing And FirstAddress. _
Address <> ThisAddress
End With
NextSheet:
Next Ws
Finish:
If Reply = vbYes Then
Exit Sub
Else
FirstSheet.Select
MsgBox "Search Completed - Sorry, no more " & Lost & "s", _
vbInformation, "No Region Selected"
End If
End Sub

[/VBA]

thank you

[GTO]

Greetings and welcome to vbaexpress.

I just scanned quickly, but it is doubtful that you need all the selecting going on.

Could you post an example workbook (in .xls format) with the code, and specify where we're plunking in the 'how many found' number(s)? Just a couple of sheets would seem helpful, and of course, obfuscate any private data.

Again, welcome to the site. YOu will no doubt like it, as there's great folks here

Mark