redrumkev
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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("Sheet 1")
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
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("Sheet
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
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!
ASKER
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