There has to be a faster way to do this...

Xeroid

Board Regular
Joined
Aug 14, 2002
Messages
64
Hi Folks.

I am trying to get a macro to look at all the cells that show the word "match" in column E, and then copy the cells from B, C, and D from the same line to the bottom of another worksheet.

Here is the code I have so far:

Sheets("Comparison").Activate
rowcounter = Range("e65535").End(xlUp).Row
Dim i As Integer
Dim j As Integer
j = 1
If rowcounter < 1 Then Stop

For Each cell In Range("E2:E" & rowcounter)
i = 1
j = j + 1
If cell.Value = "Match" Then
Range("B" & j & ",C" & j & ",D" & j & ",E" & j).Copy _
Sheets("Extracted").Range("A65535").End(xlUp).Offset(1, 0)
End If
Next cell

It is PAINFULLY slow. There should be a way to just select all the cells at once and then copy over in one chunk, rather than copying one row at a time, but my VBA skill are "limited" to say the least.

Please help! :rolleyes:
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Hello

HOw about

Code:
Sub copy()
Application.ScreenUpdating = False
For MY_ROWS = 1 To Sheets("Sheet1").Range("E65536").End(xlUp).Row
    If Sheets("Sheet1").Range("E" & MY_ROWS).Value = "match" Then
        Sheets("Sheet1").Range("A" & MY_ROWS & ":D" & MY_ROWS).copy
        Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
    End If
Next MY_ROWS
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hello

HOw about

Code:
Sub copy()
Application.ScreenUpdating = False
For MY_ROWS = 1 To Sheets("Sheet1").Range("E65536").End(xlUp).Row
    If Sheets("Sheet1").Range("E" & MY_ROWS).Value = "match" Then
        Sheets("Sheet1").Range("A" & MY_ROWS & ":D" & MY_ROWS).copy
        Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
    End If
Next MY_ROWS
Application.ScreenUpdating = True
End Sub

I hate to say it, but the above code was even slower than mine. It also made my screen do weird things, although this could probably be fixed by using the "application.screenupdate = false" line.

The list is being compared against another list with nearly 30,000 entries on it.
 
Upvote 0
If column E has a header, and I think it does since you start your loop in row 2, then you could use advanced filter.
Code:
Sub CopyMatch()
Dim wsComp As Worksheet
Dim wsEx As Worksheet
Dim wsCrit As Worksheet
Dim LastRow As Long

    Set wsComp = Worksheets("Comparison")
    Set wsEx = Worksheets("Extracted")
    Set wsCrit = Worksheets.Add
    
    LastRow = wsComp.Range("E" & Rows.Count).End(xlUp).Row
    wsCrit.Range("A1:A2") = WorksheetFunction.Transpose(Array(wsComp.Range("E1"), "Match"))
    
    wsComp.Range("B1:E" & LastRow).AdvancedFilter xlFilterCopy, wsCrit.Range("A1:A2"), wsEx.Range("A1")
    
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub
 
Upvote 0
Copying matched information from a HUGE list...

AutoFilter would be quicker. copying the visible rows.

I have to admit, I have never (yet) used the autofilter. All my sorting I do with the "Data/sort" feature on the toolbar.

I wanted to do this in chunks, because the items being compared are on two other Excel workbooks, and linked into the one that is comparing them.

I have one workbook with over 9200 lines to be compared against one in another workbook with nearly 30000 lines.

Rather than have Excel calculate all the match formulae at once, I have set it up to look at the first 100 lines in the first list and mark all matches with "Match".

The macro then pulls any matches to the new sheet "Extracted".

Then I go on to the next 100, and repeat until all the lines of the first list have been compared against the second, and all the matches copied to the "Extracted" worksheet.

What if I grabbed each new set of 100, and pasted that as values to the Extracted sheet, then sorted the whole thing at the end? Would that be faster?

Insights (and time) appreciated.

Regards,

Xeroid.
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,194
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top