Faster way to loop through two ranges
I modified the code to use match function and turned off screen updating, but
it still takes about 3 minutes to loop through. Would find(What:=) save me
some time? Not sure about the exact syntax of find(what:=) to fit with my
code.
Need help. Thanks!
YH
Sub Trial ()
Dim dLastR As Long
Dim sLastR As Long
Dim sWS As Worksheet
Dim dWS As Worksheet
Dim s_RowCt As Long
Dim d_RowCt As Long
Dim sRange As Range
Dim C As Variant
Set sWS = Worksheets("VF45 Pivot Table")
Set dWS = Worksheets("DF TMP 2")
sLastR = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
dLastR = dWS.Cells(dWS.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Set sRange = sWS.Range("A5:A" & sLastR)
For d_RowCt = 2 To dLastR
C = Application.Match(dWS.Cells(d_RowCt, 8).Value, sRange, 0)
If IsError(C) Then
dWS.Cells(d_RowCt, 2).Value = "N"
Else
dWS.Cells(d_RowCt, 2).Value = "Y"
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
"Norman Jones" wrote:
Hi YH,
In addition to Tim's excellent suggestions, turn off ScreenUpdating,
automatic calculation and PageBreak display at the start of the procedure
and restore the required settings at the end.
---
Regards,
Norman
"YH" wrote in message
...
I need a faster way to loop through two columns. I have two columns on two
separate worksheets, and I need to see if a cell value in column1 matches
any
cell value in column2. I have 50,000 cells in Column1 and 230 cells in
column2. Using the Sub below takes me 3 minutes to loop through all
cells,
and I need a way to cut down a chunk of the processing time.
Anyone has a better idea?
Thanks,
YH
Sub Trial()
Dim dLastR As Long
Dim sLastR As Long
'sWS is the source worksheet
'dWS is the destination worksheet
Dim sWS As Worksheet
Dim dWS As Worksheet
Dim s_RowCt As Long
Dim d_RowCt As Long
Set sWS = Worksheets("VF45 Pivot Table")
Set dWS = Worksheets("DF TMP")
sLastR = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
dLastR = dWS.Cells(dWS.Rows.Count, "A").End(xlUp).Row
For d_RowCt = 2 To dLastR
For s_RowCt = 1 To sLastR
If dWS.Cells(d_RowCt, 8).Value = sWS.Cells(s_RowCt, 1).Value
Then
dWS.Cells(d_RowCt, 2).Value = "Y"
Exit For
End If
If s_RowCt = sLastR Then
dWS.Cells(d_RowCt, 2).Value = "N"
End If
Next
Next
end Sub
|