asked on

VBA - Take Errors by column and pass to Case based String selection.

Experts,

I am trying to use the errors found by column to load a case select where the case:

Case 0 - do nothing
Case 1 - load a string with singular verbiage
Case else - load a string with plural verbiage

Then if the cases all equal 0 (ie, no errors found) display the "Great Success Message"
else
"There were 2 errors in Premium", "There is 1 errors in Something else", etc.

Kevin

Sub FIX_INPUT_ERRORS()

    Dim Cell As Range
    Dim SourceRange As Range
    Dim Map As Collection
    Dim ColumnLetters As Variant
    Dim ColumnLetter As Variant
    Dim Index As Long
    Dim Errors(1 To 7) As Variant
   
    ColumnLetters = Array("D", "F", "H", "I", "P", "Q", "S")
   
    Set Map = New Collection
    Index = 1
    For Each ColumnLetter In ColumnLetters
       Map.Add Index, ColumnLetter
       Index = Index + 1
    Next ColumnLetter
   
    For Each ColumnLetter In ColumnLetters
        With ThisWorkbook.Sheets("Sheet1")
            Set SourceRange = Range(Cells(2, ColumnLetter), Cells(.Rows.Count, ColumnLetter).End(xlUp))
            For Each Cell In SourceRange
                If Cell.Value < 1 Then
                    Errors(Map(ColumnLetter)) = Errors(Map(ColumnLetter)) + 1
                End If
            Next Cell
        End With
    Next ColumnLetter

'The use a similar structure to this case select structure to load the message box

' To Display Message Box or not
Select Case TargA
    Case 0
        ' skip to TargB
    Case 1
        strTargA = "THERE IS " & TargA & " CELL NOT MARKED AS 'M' - FOR MEDICARE" & vbCrLf
    Case Else
        strTargA = "THERE ARE " & TargA & " CELLS NOT MARKED AS 'M' - FOR MEDICARE" & vbCrLf
End Select
Select Case TargB
    Case 0 ' skip to string assembly for message box
    Case 1
    strTargB = "THERE IS " & TargB & "CELL WITHOUT A PREMIUM VALUE" & vbCrLf
    Case Else
    strTargB = "THERE ARE " & TargB & " CELLS WITHOUT PREMIUM VALUE" & vbCrLf
End Select
' Then I want to assemble the above strings, if not null such as:

If TargA + TargB = 0 Then
   MsgBox "Operations successful"
Else
   MsgBox strTargA + strTargB + "PLEASE CORRECT THE ABOVE IN GM AND RE-QUERY THE DATA"
End If

End Sub

Open in new window

ASKER CERTIFIED SOLUTION

zorvek (Kevin Jones)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

redrumkev

ASKER

Kevin,

This will work - because I am just going to list the error count and the text string does not need to change.

It tells them singular or plural and gives them a column to go to, perfect!

Thank you SO MUCH - I know this one was more than a bit involved!!!!

Kevin

zorvek (Kevin Jones)

Now for the points.

Sub FIX_INPUT_ERRORS()

Dim Cell As Range
Dim SourceRange As Range
Dim Map As Collection
Dim ColumnLetters As Variant
Dim ColumnLetter As Variant
Dim Index As Long
Dim Errors(1 To 7) As Variant
Dim Message As String

ColumnLetters = Array("D", "F", "H", "I", "P", "Q", "S")

Set Map = New Collection
Index = 1
For Each ColumnLetter In ColumnLetters
Map.Add Index, ColumnLetter
Index = Index + 1
Next ColumnLetter

For Each ColumnLetter In ColumnLetters
With ThisWorkbook.Sheets("Sheet1")
Set SourceRange = Range(Cells(2, ColumnLetter), Cells(.Rows.Count, ColumnLetter).End(xlUp))
For Each Cell In SourceRange
If Cell.Value < 1 Then
Errors(Map(ColumnLetter)) = Errors(Map(ColumnLetter)) + 1
End If
Next Cell
End With
Next ColumnLetter

For Each ColumnLetter In ColumnLetters
If Errors(Map(ColumnLetter)) > 0 Then
If Errors(Map(ColumnLetter)) > 1 Then
Message = Message & IIf(Len(Message) = 0, "", vbCrLf) & "There are " & Errors(Map(ColumnLetter)) & " cells without premium values in column " & ColumnLetter & "."
Else
Message = Message & IIf(Len(Message) = 0, "", vbCrLf) & "There is 1 cell without a premium value in column " & ColumnLetter & "."
End If
End If
Next ColumnLetter
If Len(Message) > 0 Then
MsgBox Message & vbCrLf & "Please correct the above in GM re-query the data."
Else
MsgBox "Operations successful."
End If

End Sub

Kevin

redrumkev

ASKER

NOW THIS IS PERFECT - that added the last line to let them know to go to the DB and re-query or that everything was successful!