1
\$\begingroup\$

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
asked Dec 3, 2020 at 17:08
\$\endgroup\$

3 Answers 3

1
\$\begingroup\$

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
answered Dec 4, 2020 at 22:15
\$\endgroup\$
1
  • \$\begingroup\$ thanks I think this is the most elegant way of combining everything and also efficient thanks. \$\endgroup\$ Commented Dec 7, 2020 at 16:18
4
\$\begingroup\$

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 
answered Dec 3, 2020 at 17:30
\$\endgroup\$
2
  • \$\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\$ Commented 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\$ Commented Dec 4, 2020 at 13:54
1
\$\begingroup\$

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
answered Dec 4, 2020 at 13:34
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.