Automatically skip blank and highlight updated cells

[t.pham41]

Hi all,
I am new to macros, but I was able to search around for the codes that I needed, but I'm still needing some help.
Basically, I have two worksheets, vinyl & schedule. In the 'Schedule' sheet, I have 2 command buttons, one is Import, which I use for importing new daily work orders into my 'vinyl' sheet.
And the other button is Update, which compare all of the values in col B, says..B37 with the value of B37 in my 'vinyl' sheet. If both values matches, but their "due dates" (A37's) are different, then
after I hit the Update button, on my 'vinyl' sheet, cell A37 would automatically change to the same due date as cell A37 in the 'Schedule' sheet. I hope I made sense.

Now, what I would like to do is for any "due date" cells that are changed, they would automatically highlight in red, so that I track which work orders that the company has changed the their due dates.
Another problem is my actual workbook has 10s of thousands of rows in the 'vinyl' worksheet. When I hit the Update button in 'Schedule' sheet, it takes over 9 minutes and more...
I read somewhere that skipping blank cells would make the code runs much faster. I've tried some codes from other people on the internet, but I am stuck. Please help!

I am at work right now, so I'm unable to attach my workbook for reference. So please look at my codes below. Many thanks in advance... Tom

Private Sub CommandButton1_Click() "This is Update button
Dim i As Long
Dim j As Long

With Application
.ScreenUpdating = False
.Calculation = xlManual
.EnableEvents = False
End With

Sheet1LastRow = Worksheets("vinyl").Range("B" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Schedule").Range("B" & Rows.Count).End(xlUp).Row

For j = 1 To Sheet1LastRow
For i = 1 To Sheet2LastRow

If Worksheets("vinyl").Cells(j, 2).Value = Worksheets("Schedule").Cells(i, 2).Value Then
Worksheets("vinyl").Cells(j, 1).Value = Worksheets("Schedule").Cells(i, 1).Value

Else
End If

Next i
Next j

With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.EnableEvents = True
End With

End Sub

Private Sub CommandButton2_Click() 'This is the Import button
Dim lRow As Long, lastRowE As Long

With Application
.ScreenUpdating = False
.Calculation = xlManual
.EnableEvents = False
End With
Sheets("Schedule").Select
lRow = Sheets("Schedule").Range("B" & Rows.Count).End(xlUp).Row
lastRowE = Sheets("vinyl").Range("B" & Rows.Count).End(xlUp).Row

For Each cell In Range("B2:B" & lRow)
On Error GoTo docopy
r = Rows(Application.Match(cell.Value, Sheets("vinyl").Range("B2:B" & lastRowE), 0)).Row

Next
Exit Sub

Cells.Find(What:="Schedule (below)", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
docopy:
cell.EntireRow.Copy Sheets("vinyl").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Resume Next

With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.EnableEvents = True
End With
End Sub

[AlphaFrog]

Hi and welcome to the forum.

You could add this one line to your existing CommandButton1_Click code.

If Worksheets("vinyl").Cells(j, 2).Value = Worksheets("Schedule").Cells(i, 2).Value Then
Worksheets("vinyl").Cells(j, 1).Value = Worksheets("Schedule").Cells(i, 1).Value
Worksheets("vinyl").Cells(j, 1).Interior.Color = vbRed
Else
End If

To make your code run faster, replace your CommandButton1_Click code with this.

Private Sub CommandButton1_Click()    'This is Update button
    Dim i     As Long
    Dim v     As Variant
    Dim ws As Worksheet
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
    
    With CreateObject("Scripting.Dictionary")
    
        With Worksheets("Schedule")
            v = .Range("A1", .Range("B" & Rows.Count).End(xlUp)).Value
        End With
    
        For i = 1 To UBound(v, 1)
            .Item(v(i, 2)) = v(i, 1)
        Next i
    
        Set ws = Worksheets("vinyl")
        v = ws.Range("A1", ws.Range("B" & Rows.Count).End(xlUp)).Value
        For i = 1 To UBound(v, 1)
            If .Exists(v(i, 2)) Then
                If v(i, 1) <> .Item(v(i, 2)) Then
                    ws.Range("A" & i).Value = .Item(v(i, 2))
                    ws.Range("A" & i).Interior.Color = vbRed
                End If
            End If
        Next i
    
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
        .EnableEvents = True
    End With
    
End Sub

[t.pham41]

Hi Alpha,

I've replied to your post but don't know if it goes through.
I thought I would give this more try. Your code works perfectly!!! However, is it possible to just automatically highlighting the cells Only if their due dates are different? If both due dates on both sheets are the same, no need to automatically highlight in red...
Thank you very much again..