I am trying to locate the top 10 in a list of thousands of entries, to create an ongoing report of failures of hardware. The report displays a top 10 for various things. For example top 10 errors, top 10 downtime etc. It is used to target engineers to the most critical machines in a manufacturing facility.
Our macro has worked OK for when we have had 255 errors. We have now extended our error list to 2048, and we envisage that our macros will run incredibly slowly.
I have an idea to utilise the Search and Replace function, and utilise the number of replacements to achieve the top 10. Manually a message box is displayed giving this number. When recording this macro, no message box is seen (which is good) but I cannot locate where the number is.
The function returns a Boolean.
Macro recorded looks like this.
Sub searchmacrotest()
' searchmacrotest Macro
Cells.Replace What:="a", Replacement:="AZ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="AZ", Replacement:="a", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
The first line simply changes the a to Az, and the second changes it back to a. They run quickly and gave a number of 75 with my list.
Logic:
Countif to count the occurrences of this unique word after replacingCode: Try this
Sub GetReplaceCount()
Dim ws As Worksheet
'~~> Set this to a word which is unique
Dim magicword As String: magicword = "Sid" & Format(Now, ddmmyyhhmmss)
'~~> This is what you want to replace
Dim searchText As String: searchText = "a"
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
.Cells.Replace What:=searchText, Replacement:=magicword, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'~~> This will give you the number of occurences
Debug.Print Application.WorksheetFunction.CountIf(.UsedRange, "*" & magicword & "*")
.Cells.Replace What:=magicword, Replacement:=searchText, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With