VBA Calculate percentage - excel

Question

So i need some help. Im pretty new to VBA so im having some trouble.
Well i have multiple sheets in my work book (excel). what im trying to do is, calculate the percentage of how many cells have the word "IMCOMPLETE" in column D and putting the outcome in the main sheet on a certain cell. Example:
Sub Get_Percentage()
If Range("Jackson,_Mr._Vince_R.TrainingSt'!D2:D100").Value = "IMCOMPLETE" Then
put outcome in "TotalSummery%"!E2
If Range("Carter,_Mr._Oscar_R_(Oscar)Trai'!D2:D100").Value = "IMCOMPLETE" Then
put outcome in "TotalSummery%"!E4
If Range("Taravella,_Mr._Jim_(Jim)Trainin'!D2:D100") Value = "IMCOMPLETE" Then
put outcome in "TotalSummery%"!E5
End Sub
FYI: I have like 10 sheet tabs. Not sure if this would be a macro.

Answer 1

Sub FindAndCountWordInExcelWorkBook(Byval SearchString As String)
SearchString = "IMCOMPLETE"
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim ExitLoop As Boolean
Dim FoundAt As String
On Error GoTo Err
Dim i As Integer
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
Set oRange = ws.UsedRange
Dim CountOfKeyWord As Integer
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
FoundAt = aCell.Address
Do While ExitLoop = False
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
CountOfKeyWord = CountOfKeyWord + 1
FoundAt = FoundAt & ", " & aCell.Address
Else
ExitLoop = True
End If
Loop
Else
' MsgBox SearchString & " not Found"
End If
Next i
MsgBox "The Search String: " & SearchString & ", appeared " & CountOfKeyWord & " times at these locations: " & FoundAt
Exit Sub
Err:
MsgBox Err.Description
End Sub

Answer 2

Here is a simple way to do it. I am doing it for one sheet. You can use it in a loop
Sub Sample()
Dim ws As Worksheet
Dim SearchText As String
Dim WordCount As Long, ColDTotalWordCount As Long
Dim PercentageWord As Double
Set ws = ThisWorkbook.Sheets("Sheet1")
SearchText = "IMCOMPLETE"
With ws
'~~> Count the occurances of the word "IMCOMPLETE"
WordCount = Application.WorksheetFunction.CountIf(.Columns(4), SearchText)
'~~> Count the total words in Col D
ColDTotalWordCount = Application.WorksheetFunction.CountA(.Columns(4))
'~~> Calculate Percentage
PercentageWord = WordCount / ColDTotalWordCount
Debug.Print Format(PercentageWord, "00.00%")
End With
End Sub
The above code can be also converted to a function which can be very useful when you are looping through the sheets.
Option Explicit
Sub Sample()
Dim wSheet As Worksheet
Dim TextToSearch As String
Set wSheet = ThisWorkbook.Sheets("Sheet1")
TextToSearch = "IMCOMPLETE"
Debug.Print GetPercentage(wSheet, TextToSearch)
End Sub
Function GetPercentage(ws As Worksheet, SearchText As String) As String
Dim WordCount As Long, ColDTotalWordCount As Long
Dim PercentageWord As Double
With ws
'~~> Count the occurances of the word "IMCOMPLETE"
WordCount = Application.WorksheetFunction.CountIf(.Columns(4), SearchText)
'~~> Count the total words in Col D
ColDTotalWordCount = Application.WorksheetFunction.CountA(.Columns(4))
'~~> Calculate Percentage
PercentageWord = WordCount / ColDTotalWordCount
GetPercentage = Format(PercentageWord, "00.00%")
End With
End Function