Guest User

Untitled

a guest
Jan 19th, 2019
86
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.21 KB | None | 0 0
  1. Sub Get_Percentage()
  2.  
  3. If Range("Jackson,_Mr._Vince_R.TrainingSt'!D2:D100").Value = "IMCOMPLETE" Then
  4. put outcome in "TotalSummery%"!E2
  5. If Range("Carter,_Mr._Oscar_R_(Oscar)Trai'!D2:D100").Value = "IMCOMPLETE" Then
  6. put outcome in "TotalSummery%"!E4
  7. If Range("Taravella,_Mr._Jim_(Jim)Trainin'!D2:D100") Value = "IMCOMPLETE" Then
  8. put outcome in "TotalSummery%"!E5
  9.  
  10. End Sub
  11.  
  12. Sub FindAndCountWordInExcelWorkBook(Byval SearchString As String)
  13.  
  14. SearchString = "IMCOMPLETE"
  15.  
  16. Dim oRange As Range, aCell As Range, bCell As Range
  17. Dim ws As Worksheet
  18. Dim ExitLoop As Boolean
  19. Dim FoundAt As String
  20. On Error GoTo Err
  21. Dim i As Integer
  22. For i = 1 To Worksheets.Count
  23.  
  24. Set ws = Worksheets(i)
  25. Set oRange = ws.UsedRange
  26.  
  27. Dim CountOfKeyWord As Integer
  28.  
  29. Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
  30. If Not aCell Is Nothing Then
  31. Set bCell = aCell
  32. FoundAt = aCell.Address
  33. Do While ExitLoop = False
  34. Set aCell = oRange.FindNext(After:=aCell)
  35.  
  36. If Not aCell Is Nothing Then
  37. If aCell.Address = bCell.Address Then Exit Do
  38. CountOfKeyWord = CountOfKeyWord + 1
  39. FoundAt = FoundAt & ", " & aCell.Address
  40. Else
  41. ExitLoop = True
  42. End If
  43. Loop
  44. Else
  45. ' MsgBox SearchString & " not Found"
  46. End If
  47.  
  48. Next i
  49.  
  50. MsgBox "The Search String: " & SearchString & ", appeared " & CountOfKeyWord & " times at these locations: " & FoundAt
  51. Exit Sub
  52. Err:
  53. MsgBox Err.Description
  54. End Sub
  55.  
  56. Sub Sample()
  57. Dim ws As Worksheet
  58. Dim SearchText As String
  59. Dim WordCount As Long, ColDTotalWordCount As Long
  60. Dim PercentageWord As Double
  61.  
  62. Set ws = ThisWorkbook.Sheets("Sheet1")
  63.  
  64. SearchText = "IMCOMPLETE"
  65.  
  66. With ws
  67. '~~> Count the occurances of the word "IMCOMPLETE"
  68. WordCount = Application.WorksheetFunction.CountIf(.Columns(4), SearchText)
  69.  
  70. '~~> Count the total words in Col D
  71. ColDTotalWordCount = Application.WorksheetFunction.CountA(.Columns(4))
  72.  
  73. '~~> Calculate Percentage
  74. PercentageWord = WordCount / ColDTotalWordCount
  75. Debug.Print Format(PercentageWord, "00.00%")
  76. End With
  77. End Sub
  78.  
  79. Option Explicit
  80.  
  81. Sub Sample()
  82. Dim wSheet As Worksheet
  83. Dim TextToSearch As String
  84.  
  85. Set wSheet = ThisWorkbook.Sheets("Sheet1")
  86.  
  87. TextToSearch = "IMCOMPLETE"
  88.  
  89. Debug.Print GetPercentage(wSheet, TextToSearch)
  90. End Sub
  91.  
  92. Function GetPercentage(ws As Worksheet, SearchText As String) As String
  93. Dim WordCount As Long, ColDTotalWordCount As Long
  94. Dim PercentageWord As Double
  95.  
  96. With ws
  97. '~~> Count the occurances of the word "IMCOMPLETE"
  98. WordCount = Application.WorksheetFunction.CountIf(.Columns(4), SearchText)
  99.  
  100. '~~> Count the total words in Col D
  101. ColDTotalWordCount = Application.WorksheetFunction.CountA(.Columns(4))
  102.  
  103. '~~> Calculate Percentage
  104. PercentageWord = WordCount / ColDTotalWordCount
  105. GetPercentage = Format(PercentageWord, "00.00%")
  106. End With
  107. End Function
Add Comment
Please, Sign In to add comment