Can someone review my code and provide feedback. For context in column A will be a status message of "OK" or "NOK" and this little function just counts the number of times this appear so I can update a label in another procedure. Not too sure if this is the most efficient way of doing this because looping will create delay going row by row if the data set is very large as in the main procedure this function will be called to update the label is in a loop so depending on the size of the data it can be small or very large and will trigger this function for each row.
Function UploadStatus(ByRef WS As Worksheet, ByVal StartRow As Long, ByVal EndRow As Long, Optional ByVal strMsg As String) As String
Dim OK As Long
Dim NOK As Long
Dim i As Long
Dim uploadMsg As String
If StartRow = 0 And EndRow = 0 Then Exit Function
With WS
For i = StartRow To EndRow
If .Range("A" & i).value = "OK" Then
OK = OK + 1
Else
If .Range("A" & i).value <> vbNullString Then
NOK = NOK + 1
End If
End If
Next i
End With
If OK < 2 Then
uploadMsg = OK & " OK row, "
Else
uploadMsg = OK & " OK rows, "
End If
If NOK < 2 Then
uploadMsg = uploadMsg & NOK & " NOK row"
Else
uploadMsg = uploadMsg & NOK & " NOK rows"
End If
If strMsg <> vbNullString Then
UploadStatus = strMsg & " " & uploadMsg
Else
UploadStatus = uploadMsg
End If
End Function
3 Answers 3
Personally, I would not worry about the pluralizing and use row(s)
in the message. The iif
can be used to simplify the code.
Function UploadStatus2(ByRef WS As Worksheet, ByVal StartRow As Long, ByVal EndRow As Long, Optional ByVal strMsg As String) As String
Dim Target As Range
With WS
On Error Resume Next
Set Target = .Range(.Cells(StartRow, "A"), .Cells(EndRow, "A"))
If Err.Number <> 0 Then Exit Function
On Error GoTo 0
End With
Dim OK As Long, NOK As Long
With WorksheetFunction
OK = .CountIf(Target, "OK")
NOK = .CountIf(Target, "NOK")
UploadStatus2 = .TextJoin(" ", True, strMsg, OK, "OK", "row" & IIf(OK > 1, "s", ""), ",", _
NOK, "OK", "row" & IIf(NOK > 1, "s", ""))
End With
End Function
-
\$\begingroup\$ thanks I think this is the most elegant way of combining everything and also efficient thanks. \$\endgroup\$QuickSilver– QuickSilver2020年12月07日 16:18:21 +00:00Commented Dec 7, 2020 at 16:18
Don't reinvent the wheel. Your homemade function will never be as fast as the built in functions.
Function UploadStatus(ByRef WS As Worksheet, ByVal StartRow As Long, ByVal EndRow As Long, Optional ByVal strMsg As String) As String
Dim OK As Long
Dim NOK As Long
Dim uploadMsg As String
If StartRow = 0 And EndRow = 0 Then
Exit Function
End If
OK = WorksheetFunction.CountIf("A" & StartRow & ":A" & EndRow, "OK")
NOK = WorksheetFunction.CountIf("A" & StartRow & ":A" & EndRow, "NOK")
uploadMsg = ResultStringer(OK & "OK")
uploadMsg = uploadMsg & ResultStringer(NOK & "NOK")
If strMsg <> vbNullString Then
UploadStatus = strMsg & " " & uploadMsg
Else
UploadStatus = uploadMsg
End If
End Function
Private Function ResultStringer(ByVal Count As Long, ByVal ID as String) as String
If Count > 1 Then
ResultStringer = Count & ID & " rows, "
Else
ResultStringer = Count & ID & " row, "
End If
End Function
-
\$\begingroup\$ I got type miss match and object required errors from your answer when I tested it. I posted a modified version fixing the errors below for completeness. Thanks for the suggestion using countif. \$\endgroup\$QuickSilver– QuickSilver2020年12月04日 13:35:56 +00:00Commented Dec 4, 2020 at 13:35
-
\$\begingroup\$ It was "air coded", so that's not surprising. Glad you go it working. Be sure to click the check-mark of the answer that helped you the most \$\endgroup\$FreeMan– FreeMan2020年12月04日 13:54:03 +00:00Commented Dec 4, 2020 at 13:54
This is a refined solution based on the answer above as I found few errors when testing like type miss match and object required.
Function UploadStatus(ByRef WS As Worksheet, ByVal StartRow As Long, ByVal EndRow As Long, Optional ByVal strMsg As String) As String
Dim OK As Long
Dim NOK As Long
Dim uploadMsg As String
If StartRow = 0 And EndRow = 0 Then
Exit Function
End If
With WS.Application.WorksheetFunction
OK = .CountIf(Range("A" & StartRow & ":A" & EndRow), "OK")
NOK = .CountIf(Range("A" & StartRow & ":A" & EndRow), "NOK")
End With
uploadMsg = ResultStringer(OK, "OK")
uploadMsg = uploadMsg & ", " & ResultStringer(NOK, "NOK")
If strMsg <> vbNullString Then
UploadStatus = strMsg & " " & uploadMsg
Else
UploadStatus = uploadMsg
End If
End Function
Function ResultStringer(ByVal Count As Long, StatusID As String) As String
If Count > 1 Then
ResultStringer = Count & " " & StatusID & " rows"
Else
ResultStringer = Count & " " & StatusID & " row"
End If