blizzstorm
New Member
- Joined
- Jan 4, 2009
- Messages
- 35
Hi guys,
I have two worksheets with columns i need to compare. Each column may have identical data so i cannot use any of excel matching or lookup functions.
From my code below, you can see i need each inidividual data in one column from the column to be matched with a identical data in the second column(taking note there are other similar data in second column but only one is match with the one from first column).
However this code takes close to 15 miniutes to run with just 300 records.
Need any ideas to make the code more efficient?
Thank you all
Sub Matching()
Dim WB As Workbook
Dim WSfirst As Worksheet
Dim WSsecond As Worksheet
Dim firstrange As Range, x As Variant, y As Variant, secondrange As Variant
Set WB = ActiveWorkbook
Set WSfirst = Sheets("first")
Set WSsecond = Sheets("second")
Set firstrange = WSfirst.Range("O2:O" & Rows.Count)
Set secondrange = WSsecond.Range("I2:I" & Rows.Count)
For Each x In firstrange
For Each y In secondrange
If x = y And y.Offset(0, 1) = "" Then
y.Offset(0, 1) = "Matched"
x.Offset(0, 1) = "Matched"
End If
Next y
Next x
End Sub
I have two worksheets with columns i need to compare. Each column may have identical data so i cannot use any of excel matching or lookup functions.
From my code below, you can see i need each inidividual data in one column from the column to be matched with a identical data in the second column(taking note there are other similar data in second column but only one is match with the one from first column).
However this code takes close to 15 miniutes to run with just 300 records.
Need any ideas to make the code more efficient?
Thank you all
Sub Matching()
Dim WB As Workbook
Dim WSfirst As Worksheet
Dim WSsecond As Worksheet
Dim firstrange As Range, x As Variant, y As Variant, secondrange As Variant
Set WB = ActiveWorkbook
Set WSfirst = Sheets("first")
Set WSsecond = Sheets("second")
Set firstrange = WSfirst.Range("O2:O" & Rows.Count)
Set secondrange = WSsecond.Range("I2:I" & Rows.Count)
For Each x In firstrange
For Each y In secondrange
If x = y And y.Offset(0, 1) = "" Then
y.Offset(0, 1) = "Matched"
x.Offset(0, 1) = "Matched"
End If
Next y
Next x
End Sub
