Click here to Skip to main content
15,567,221 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
I am using below code which is comparing three columns values and copy pasting the 4th column data into other column.

My code is working fine but it is slow to perform the processing and takes much time and sometimes Not Responding window appears.

Any help to fix the problem will be appreciated

Dim ws As Worksheet
Dim ws2 As Worksheet

Set ws = Worksheets("Sheet3")
Set ws2 = Worksheets("Sheet2")

    Dim a As String, b As String, c  As Date
    For i = 3 To ws.Cells(ws.Rows.Count, 14).End(xlUp).Row

        a = ws.Cells(i, 14).Value
        b = ws.Cells(i, 15).Value
        c = ws.Cells(i, 16).Value

        For j = 3 To ws2.Cells(ws2.Rows.Count, 98).End(xlUp).Row
        
            If ws2.Cells(j, 98).Value = a _
               And ws2.Cells(j, 103).Value = b _
               And ws2.Cells(j, 114).Value = c _
               Then
                ws2.Cells(j, 120).Value = ws.Cells(j, 18).Value
            End If
        Next j

    Next i


What I have tried:

I created the solution but it is slow.
Posted
Updated 19-Aug-21 23:03pm
Comments
Richard Andrew x64 19-Aug-21 16:35pm    
I suggest you look into what methods are available for selecting complete ranges, and then copying them to other places. Doing it cell by cell must be what's making it slow.
ShoRaj 20-Aug-21 0:10am    
can you please share which methods are available. will appreciate the help.

 
Share this answer
 
Start by caching the end row numbers so that you're not calculating them on every iteration of the loop:
VBA
Dim wsRow As Long, ws2Row As Long
wsRow = ws.Cells(ws.Rows.Count, 14).End(xlUp).Row
ws2Row = ws2.Cells(ws2.Rows.Count, 98).End(xlUp).Row

For i = 3 To wsRow
   ...
   For j = 3 To ws2Row
      ...

But remember, the performance of your code will depend on how many rows are in your source and destination sheets. The total number of iterations is going to be the product of the two - if ws has 42 rows and ws2 has 1000 rows, your inner loop will execute 42000 times.

If there will only be one matching row in ws2, then you should exit from the inner loop as soon as you find a match:
VBA
If ws2.Cells(j, 98).Value = a _
    And ws2.Cells(j, 103).Value = b _
    And ws2.Cells(j, 114).Value = c _
    Then
    ws2.Cells(j, 120).Value = ws.Cells(j, 18).Value
    Exit For
End If
 
Share this answer
 
Comments
ShoRaj 23-Aug-21 7:14am    
Using your way it still takes same time
The following code snippet is an example of copying large ranges from one sheet to another
VB
Dim ws As Worksheet
    Dim ws2 As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet3")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    Dim i As Long
    i = ws.Cells(ws.Rows.Count, 14).End(xlUp).Row

    Dim sourceRng As Range, targetRng As Range
    Set sourceRng = ws.Range("A3:Z" & CStr(i))
    Set targetRng = ws2.Range(sourceRng.Address)

    targetRng.Value = sourceRng.Value

Instead of doing that comparison in code insert a column into the source worksheet, with a formula that essentially equates to "should I copy this row", then filter on that or sort on that column (in VBA). Then derive the required range, then copy it over.

Even better and faster would be to set up a power query to do this work
 
Share this answer
 
Comments
ShoRaj 23-Aug-21 7:15am    
Cannot add a formula into sheet it may slow the working of sheet.
CHill60 23-Aug-21 7:38am    
That rather depends on the formula - it's the thing that Excel is actually quite good at.
But it will be a lot (and by that I mean, A LOT) faster using my suggested approach than by examining each line one by one, even if you 1,048,575 rows of data needing to be calculated. Trust me, I do stuff like this every day.

You can avoid unnecessary calculations on formulas by changing the Calculation Options under the Formulas menu. Just remember to turn it back on when you exit this workbook

Or, as I said - use a power query.
ShoRaj 23-Aug-21 7:48am    
Right CHill60 I will try to follow to your suggestion.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900