Could I please get help simplifying (if possible) the message box.
Currently, the message box pops at the end of the code and displays the following when it finds a duplicate in a row between range B and K.
cell.address and cell.value
cell.address and cell.value
And repeats any duplicate values underneath in a single message box.
I'm trying to get it to display
"Repeat Dates found in rows" & vbNewline &_
row.address cell.value - cell.value" & vbNewLine
Thanks in advance for any help.
Currently, the message box pops at the end of the code and displays the following when it finds a duplicate in a row between range B and K.
cell.address and cell.value
cell.address and cell.value
And repeats any duplicate values underneath in a single message box.
I'm trying to get it to display
"Repeat Dates found in rows" & vbNewline &_
row.address cell.value - cell.value" & vbNewLine
Thanks in advance for any help.
Code:
Sub test1()
Dim Counter As Integer
Dim Msg As String
Application.ScreenUpdating = False
For Counter = 6 To 300
bValue = ActiveSheet.Cells(Counter, 2)
cValue = ActiveSheet.Cells(Counter, 3)
dValue = ActiveSheet.Cells(Counter, 4)
eValue = ActiveSheet.Cells(Counter, 5)
fValue = ActiveSheet.Cells(Counter, 6)
gValue = ActiveSheet.Cells(Counter, 7)
hValue = ActiveSheet.Cells(Counter, 8)
iValue = ActiveSheet.Cells(Counter, 9)
jValue = ActiveSheet.Cells(Counter, 10)
kValue = ActiveSheet.Cells(Counter, 11)
For Each cl In ActiveSheet.Cells(Counter, 2)
If bValue = dValue And bValue <> "" Then
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If bValue = fValue And bValue <> "" Then
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If bValue = hValue And bValue <> "" Then
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If bValue = jValue And bValue <> "" Then
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
Next cl
'''''''''' B----D---F-----H-----J---
For Each cl In ActiveSheet.Cells(Counter, 4)
If dValue = bValue And dValue <> "" Then
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If dValue = fValue And dValue <> "" Then
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If dValue = hValue And dValue <> "" Then
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If dValue = jValue And dValue <> "" Then
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
Next cl
'''''''''' B----D---F-----H-----J---
For Each cl In ActiveSheet.Cells(Counter, 6)
If fValue = bValue And fValue <> "" Then
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If fValue = dValue And fValue <> "" Then
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If fValue = hValue And fValue <> "" Then
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If fValue = jValue And fValue <> "" Then
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
Next cl
'''''''''' B----D---F-----H-----J---
For Each cl In ActiveSheet.Cells(Counter, 8)
If hValue = bValue And hValue <> "" Then
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If hValue = dValue And hValue <> "" Then
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If hValue = fValue And hValue <> "" Then
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If hValue = jValue And hValue <> "" Then
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
Next cl
'''''''''' B----D---F-----H-----J---
For Each cl In ActiveSheet.Cells(Counter, 10)
If jValue = bValue And jValue <> "" Then
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 2).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 3).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If jValue = dValue And jValue <> "" Then
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 4).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 5).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If jValue = fValue And jValue <> "" Then
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 6).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 7).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
'MsgBox Cell_Values
End If
If jValue = hValue And jValue <> "" Then
ActiveSheet.Cells(Counter, 10).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 11).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 8).Interior.Color = RGB(255, 10, 10)
ActiveSheet.Cells(Counter, 9).Interior.Color = RGB(255, 10, 10)
Cell_Values = Cell_Values & vbNewLine & cl.Address(False, False) & " - " & cl.Value
MsgBox Cell_Values
End If
If Msg <> "" Then
Msg = Cell_Values
Else
Msg = "test"
End If
Next cl
Next
Application.ScreenUpdating = True
End Sub