Excel comapring and copying VBA taking a long time to run

[urahulnair]

I used this macro to copy contents from one excel sheet to another, by comparing two columns and finding a matching cell. The problem is that this macro is taking a long time(close to three days) to complete. Can someone please help me to make things faster.(There are close to 4,00,000 records in both the sheets to compare against.

Option Explicit
Sub MatchAndCopy()

   Dim sheet01 As Worksheet, sheet02 As Worksheet
   Dim count As Range, matchingCell As Long
   Dim RangeInSheet1 As Variant
   Dim RangeInSheet2 As Variant
   
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = True
   
   Set sheet01 = Worksheets("Sheet1")
   Set sheet02 = Worksheets("Sheet2")
   Set RangeInSheet1 = sheet01.Columns(1)
   Set RangeInSheet2 = sheet02.Range("A2", sheet02.Range("A" & Rows.count).End(xlUp))


   For Each count In RangeInSheet2
     matchingCell = 0
     On Error Resume Next
     matchingCell = Application.Match(count, RangeInSheet1, 0)
     On Error GoTo 0
     If matchingCell <> 0 Then
       Application.StatusBar = "Please wait while data is being copied, Processing count : " & count
       sheet01.Range("F" & matchingCell).Value = count.Offset(, 1)
       sheet01.Range("G" & matchingCell).Value = count.Offset(, 2)
       sheet01.Range("H" & matchingCell).Value = count.Offset(, 3)
       sheet01.Range("I" & matchingCell).Value = count.Offset(, 4)
       sheet01.Range("J" & matchingCell).Value = count.Offset(, 5)
     End If
   Next count
   
   Application.StatusBar = False
   Application.ScreenUpdating = True
   
End Sub

 

[NeonRedSharpie]

Can you post a quick sample data and explain, in common words, what you want the macro to do?

 

[urahulnair]

Example of the problem I am having:

I have two sheets like this:

Sheet 1:

[TABLE="width: 500"]
<tbody>[TR]
[TD]id[/TD]
[TD]value_01[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]one[/TD]
[/TR]
[TR]
[TD]33345[/TD]
[TD]two[/TD]
[/TR]
[TR]
[TD]33349[/TD]
[TD]three[/TD]
[/TR]
[TR]
[TD]45611[/TD]
[TD]four[/TD]
[/TR]
</tbody>[/TABLE]

Sheet2:

[TABLE="width: 500"]
<tbody>[TR]
[TD]id[/TD]
[TD]value_02[/TD]
[/TR]
[TR]
[TD]45611[/TD]
[TD]one[/TD]
[/TR]
[TR]
[TD]33349[/TD]
[TD]two[/TD]
[/TR]
[TR]
[TD]33348[/TD]
[TD]three[/TD]
[/TR]
[TR]
[TD]45612
[/TD]
[TD]four[/TD]
[/TR]
</tbody>[/TABLE]

I need to compare the id field of these two sheets, if there is a match, copy value_02 from the second sheet and paste the data into the first sheet as another column.

As I have close to 4 lakh records in both the sheets, the macro I am using for comparision and copying is taking a long time. Please help me to optimize it.

 

[NeonRedSharpie]

And there will only be one instance of the ID? Or will there be multiple instances?

 

[urahulnair]

Zero or only ONE instance of the ID will be present in each sheet.

 

[NeonRedSharpie]

Then I think I can definitely cut down your run time by deleting a row if it has been found. Or at least skipping that row. Give me a bit to write it out and test it.

Edit to add: Why all the offsetting in your FOR statement? Are there multiple columns of data to look through? Is it more complex than your sample data?

 

[urahulnair]

Oh that is great, if the time to run this macro can be reduced.

The offesetting, is because I need to copy three columns from the second sheet and paste is to the first sheet. It is not complex than by sample data, the macro only needs to compare one column of each sheet and if a match is found copy data from the second sheet to the first sheet.

 

[NeonRedSharpie]

Sub MatchAndCopy()

   Dim refSheet As Worksheet
   Dim dataSheet As Worksheet
   Dim tempSheet As Worksheet
   
   Dim startRow As Integer
   Dim endRowRef As Long
   Dim endRowData As Long
   
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = True
   Application.DisplayAlerts = False
   
   
   Set refSheet = Worksheets("Sheet1")
   Set dataSheet = Worksheets("Sheet2")
   
   dataSheet.Copy After:=Worksheets(Worksheets.count)
   Worksheets(Worksheets.count).name = "Temp"
   
   Set tempSheet = Worksheets("Temp")
   
   startRow = 2
   endRowRef = refSheet.Cells(Rows.count, "A").End(xlUp).Row
   endRowData = dataSheet.Cells(Rows.count, "A").End(xlUp).Row
   
   refSheet.Cells(1, 23).Value = "Start " & Now()
   
    
    For x = startRow To endRowRef
        Application.StatusBar = "Please wait while data is being copied, Processing count : " & x
        For y = startRow To endRowData
            If tempSheet.Cells(y, 1).Value = "" Then
                ' Do nothing
            ElseIf refSheet.Cells(x, 1).Value = tempSheet.Cells(y, 1) Then
                refSheet.Cells(x, 3).Value = tempSheet.Cells(y, 2)
                refSheet.Cells(x, 4).Value = tempSheet.Cells(y, 3)
                refSheet.Cells(x, 5).Value = tempSheet.Cells(y, 4)
                tempSheet.Cells(x, 1).Value = ""
                Exit For
            End If
        Next y
    Next x
    
    
    tempSheet.Delete
    refSheet.Activate
    
    refSheet.Cells(2, 23).Value = "End " & Now()
   
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
End Sub

After running a sample code, I don't know if it's much faster. My sample code ran through 11,018 matches in 2 minutes and 42 seconds. Now, assuming exactly 400,000 unique IDs, there will be 36 times as many iterations to run. This gives us a total completion time of 1 hour and 38 minutes.

I don't know if this is a code differential, or a computing power differential.