Improving Speed Comparing Multiple Columns

I would like to please get assistance to improving speed for this particular following code because I have between 10,000 to 20,000 records.
In columns J and K are dates. In column L are integers.

Code:

---

Sub COMPAREMULTIPLECOLUMNS()

    Dim sh1 As Worksheet, sh2 As Worksheet

    Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long

    Set sh1 = Worksheets("CURRENT")

    Set sh2 = Worksheets("PREVIOUS")

   

    lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row

    lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row

 

    For i = 2 To lastrow1

        For j = 2 To lastrow2

            If sh1.Cells(i, "F").Value = sh2.Cells(j, "F").Value Then

                If sh1.Cells(i, "J").Value <> sh2.Cells(j, "J").Value Then               

                sh1.Cells(i, "R").Value = sh2.Cells(j, "J").Value

            End If

            End If

            If sh1.Cells(i, "F").Value = sh2.Cells(j, "F").Value Then

                If sh1.Cells(i, "K").Value <> sh2.Cells(j, "K").Value Then               

                sh1.Cells(i, "S").Value = sh2.Cells(j, "K").Value

            End If
               
            End If

            If sh1.Cells(i, "F").Value = sh2.Cells(j, "F").Value Then

                If sh1.Cells(i, "L").Value <> sh2.Cells(j, "L").Value Then               

                sh1.Cells(i, "T").Value = sh2.Cells(j, "L").Value

            End If

            End If

        Next j

    Next i

End Sub

---

I would greatly appreciate any assistance.

Plese try this one.

Code:

---

Sub OptimzeSpeed()

    Dim varArrSheet1        As Variant
    Dim varArrSheet2        As Variant
   
    Dim lngCtr1            As Long
    Dim lngCtr2            As Long
   
    Const strSheetName1      As String = "CURRENT"
    Const strSheetName2      As String = "PREVIOUS"
   
    varArrSheet1 = ThisWorkbook.Worksheets(strSheetName1).UsedRange
    varArrSheet2 = ThisWorkbook.Worksheets(strSheetName2).UsedRange
   
    ThisWorkbook.Worksheets(strSheetName1).UsedRange.ClearContents
   
   
    For lngCtr1 = LBound(varArrSheet1) To UBound(varArrSheet1)
        For lngCtr2 = LBound(varArrSheet2) To UBound(varArrSheet2)
            If varArrSheet1(lngCtr1, 5) = varArrSheet1(lngCtr2, 5) Then
                If varArrSheet1(lngCtr1, 10) <> varArrSheet1(lngCtr2, 10) Then
                    varArrSheet1(lngCtr1, 18) = varArrSheet1(lngCtr2, 10)
                End If
               
                If varArrSheet1(lngCtr1, 11) <> varArrSheet1(lngCtr2, 11) Then
                    varArrSheet1(lngCtr1, 19) = varArrSheet1(lngCtr2, 11)
                End If
               
                If varArrSheet1(lngCtr1, 12) <> varArrSheet1(lngCtr2, 12) Then
                    varArrSheet1(lngCtr1, 20) = varArrSheet1(lngCtr2, 12)
                End If
            End If
        Next
    Next
    With ThisWorkbook.Worksheets(strSheetName1)
        .UsedRange.ClearContents
        .Range(A1).Resize(UBound(varArrSheet1, 1), UBound(varArrSheet1, 2)) = varArrSheet1
    End With
   
End Sub

---

Regards
Prince

Thank you for your replay Prince. I get the subscript out of range error at this line.

Code:

---

If varArrSheet1(lngCtr1, 5) = varArrSheet1(lngCtr2, 5) Then

---

It would have been nice if you had described what the code should do under what conditions...

Code:

---

Sub M_snb()
    sn = Sheets("Current").Cells(1).CurrentRegion.Offset(, 5).Resize(, 15)
    sp = Sheets("Previous").Cells(1).CurrentRegion.Offset(, 5).Resize(, 15)

    With CreateObject("scripting.dictionary")
        For j = 1 To UBound(sn)
          .Item(sn(j, 1)) = Application.Index(sn, j, 0)
        Next

        For j = 1 To UBound(sp)
            st = .Item(sp(j, 1))
            st(13) = sp(j, 5)
            st(14) = sp(j, 6)
            st(15) = sp(j, 7)
            .Item(sp(j, 1)) = Application.Index(st)
        Next
   
        Sheets("CURRENT").Cells(1).CurrentRegion.Offset(, 5).Resize(, 15) = Application.Index(.items, 0, 0)
    End With
End Sub

---

Thanks for replying snb. I'm trying to identify date and timeframe changes from one report to the next. I tried your code and got a compile error - "array is expected" on this piece of code.

Code:

---

For j = 1 To UBound(sn)

---

check
- there are no empty cells in row 1 A1:T1
- no empty cells in column A

Hi Devid,


Can you please share your workbook, So that we can provide you exact solution.

Regards
Prince