VBA: Automatically highlight cell when user enter data that does not match with another data from a different column

[atisyam]

Hello

I am not a programmer so I apologize if my title seems confusing. This is what I meant: Cell D5 will automatically highlight as the data entered does not match with E4 for the same vehicle number. Cell D3 will not be highlighted as the data entered matched with E2 for the same vehicle number. Hope it is possible. Thanks to anyone who can help.

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Inspection date[/TD]
[TD]Vehicle Number[/TD]
[TD]Old S/N[/TD]
[TD]New S/N[/TD]
[TD]Reason[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]10/1/18[/TD]
[TD]Sm1234[/TD]
[TD]-[/TD]
[TD]098[/TD]
[TD]Bus Arrival[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]10/2/18[/TD]
[TD]Sm1234[/TD]
[TD]098[/TD]
[TD]345[/TD]
[TD]Maintenance[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]12/2/18[/TD]
[TD]Sm5678[/TD]
[TD]-[/TD]
[TD]213[/TD]
[TD]Bus Arrival[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]12/3/18[/TD]
[TD]Sm5678[/TD]
[TD]345[/TD]
[TD]639[/TD]
[TD]Maintenance[/TD]
[/TR]
</tbody>[/TABLE]

 

[RoryA]

I can't post tables through reply so I will start a new thread.

No, please stick to one thread (I've merged your follow-up into this thread)

There shouldn't be anything different about replying vs creating a new thread.

 

[atisyam]

Yep. Thanks RoryA. Seen the merged with my originally posted thread titled: "VBA: Automatically highlight cell when data entered does not match with data in other columns. If match, cell turns to 'no fill.' "

I will still be playing around with the given code by Trebor76 and see if I can get anywhere.

No, please stick to one thread (I've merged your follow-up into this thread)

There shouldn't be anything different about replying vs creating a new thread.

 

[Trebor76]

For reference this has been cross-posted here.

 

[Trebor76]

Try this event macro on the sheet in question (note the assumption about the S/N only appearing once in Col. F):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lngMyRow As Long
    Dim rngMyCell As Range
    Dim dblOldSN As Double
    Dim strStickerLocation As String
    
    Application.ScreenUpdating = False
    
    If Target.Column = 5 And Target.Row >= 2 And Len(Target.Value) > 0 Then
        dblOldSN = Range("E" & Target.Row)
        strStickerLocation = Range("G" & Target.Row)
        For Each rngMyCell In Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row)
            'Assumes there is only one S/N match in Col. F.
            If rngMyCell = dblOldSN Then
                If rngMyCell.Offset(0, 1) = strStickerLocation Then
                    Target.Interior.Color = xlNone
                    Exit For
                Else
                    Target.Interior.Color = RGB(255, 0, 0)
                    Exit For
                End If
            End If
        Next rngMyCell
    End If
    
    Application.ScreenUpdating = True

End Sub

Robert

 

[atisyam]

Thank you for the reminder. I'll take note of it for any future thread.

And the code worked! Pretty amazing. I will be putting some msg-boxes to complement the overall coding.

Thanks so much Robert! Your help was super helpful

 

[Trebor76]

Thanks for letting us know. I'm glad we got it sorted

 

[atisyam]

Hi there. I feel like I said this too soon. Now I am having issues with my msg-boxes. Sorry.

Once the cell turns red, a pop up box will appear with a retry and cancel option. If the user press retry, the cell will return back and allow the user to re-enter the data (E.g. E4 will turn red when entered 3847, popup, user choose to retry, return back to E4 to re-enter). If still incorrect the same pop-up box will reappear until the user press cancel so another pop up information will denote that cell will remain red and macro will just continue as per normal.

Here is my code. Changes to column and row alphabets/numbers are made applicable to actual excel sheet.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)


Dim lngMyRow As Long
Dim rngMyCell As Range
Dim dblOldSN As Double
Dim strStickerLocation As String
Dim Output As Integer



Application.ScreenUpdating = False

If Target.Column = 6 And Target.Row >= 3 And Len(Target.Value) > 0 Then
dblOldSN = Range("F" & Target.Row)
strStickerLocation = Range("H" & Target.Row)
For Each rngMyCell In Range("G3:G" & Range("G" & Rows.Count).End(xlUp).Row)
'Assumes there is only one S/N match in Col. G.
If rngMyCell = dblOldSN Then
If rngMyCell.Offset(0, 1) = strStickerLocation Then
Target.Interior.Color = xlNone
Exit For
Else
Target.Interior.Color = RGB(255, 0, 0)
Output = MsgBox("Serial No. does not match with previous record. Continue?", vbRetryCancel, "Incorrect Serial No.")
If Output = vbRetry Then
ActiveCell.Select
Else
MsgBox "Red cell will denote as error", vbInformation
Exit For
End If
End If
Next rngMyCell
End If

Application.ScreenUpdating = True


End Sub

I just cannot get this right. Will continue looking up for other methods to solve this. Will appreciate the solution to this. Thank yoouu

Thanks for letting us know. I'm glad we got it sorted

 

[Trebor76]

Is this what you're after:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngMyCell As Range
    Dim dblOldSN As Double
    Dim strStickerLocation As String
    
    Application.ScreenUpdating = False
    
    If Target.Column = 6 And Target.Row >= 3 And Len(Target.Value) > 0 Then
        dblOldSN = Range("F" & Target.Row)
        strStickerLocation = Range("H" & Target.Row)
        For Each rngMyCell In Range("G3:G" & Range("G" & Rows.Count).End(xlUp).Row)
            'Assumes there is only one S/N match in Col. G.
            If rngMyCell = dblOldSN Then
                If rngMyCell.Offset(0, 1) = strStickerLocation Then
                    Target.Interior.Color = xlNone
                    Exit For
                End If
            Else
                Target.Interior.Color = RGB(255, 0, 0)
                If MsgBox("Serial No. does not match with previous record. Continue?", vbRetryCancel, "Incorrect Serial No.") = vbRetry Then
                    Target.Select
                    Exit For
                Else
                    MsgBox "Red cell will denote as error", vbInformation
                    Exit For
                End If
            End If
        Next rngMyCell
    End If

    Application.ScreenUpdating = True

End Sub

Please use the correct tags i.e. [CODE] Code goes here [/CODE] when posting code.

Robert

 

[atisyam]

I see. Noted for the coding tag, will take note for future postings. And yep, your code is per what I intended.

Thanks again Mr Robert!

 

[Trebor76]

Thanks atisyam