Slow Looping

  • Thread starter Thread starter Matt
  • Start date Start date
M

Matt

I'm trying to over come a problem of slow looping, I have 2 sheets both of
which have about 32,000 rows when I use a macro with loops it takes for ever
to find the entries that are on one sheet but not on another. I have tried
the formala below and have tried to adapt it to suit my needs but can not
get it to work. My two sheets have two columns and both of them havve to
match. In the example below I need to isolate the row with the xxxxxx
beside it. I has invoice numbers that are on the other sheet and the same
amount but the combination of invoice number and amount is unique. All the
other pairs have a match on the other sheet. Any help would be greatly
appreciatied.


=IF(COUNTIF($A$1:$A$10,B1)=0,B1,"")





sheet1 sheet 2

inv number amount invoice no amount


104546 $ 250.25 154265 $ 4,625.00
451567 $ 1,000.25 254256 $ 1,456.45
254256 $ 1,456.45 451567 $ 25.60
451453 $ 65,452.00 XXXXXXX 154265 $ 25.60 XXXXX
654245 $ 450.96 451453 $ 65,452.00
324154 $ 6,542.25 654245 $ 450.96
154265 $ 4,625.00 104546 $ 250.25
451567 $ 25.60 324154 $ 6,542.25
654245 $ 1,456.20 654245 $ 1,456.20
254256 $ 250.25 254256 $ 250.25
324154 $ 1,000.25 451567 $ 1,000.25
451567 $ 25.60 324154 $ 1,000.25
451567 $ 25.60



Matt
 
Matt,

I can think of quicker ways. Merging, Sorting, etc.. But here's the quick
and ugly. Not sure how it'll perform over 32000 rows - probably poorly.

Assumes data is in columns A and B and that XXXXX is written to column C

Sub testit()
Dim wksS As Worksheet, wksD As Worksheet
Dim i As Long, j As Long, lngLastRowS As Long, lngLastRowD As Long
Dim blnFound As Boolean

Set wksS = Sheet2
Set wksD = Sheet1

lngLastRowS = wksS.Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowD = wksD.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lngLastRowS
blnFound = False
For j = 1 To lngLastRowD
If wksS.Cells(i, 1) = wksD.Cells(j, 1) And wksS.Cells(i, 2) =
wksD.Cells(j, 2) Then
blnFound = True
Exit For
End If
Next
If Not blnFound Then wksS.Cells(i, 3) = "XXXXX"
Next
End Sub

Rob
 
Saw the reply, and tested it - you could try this (which
is much quicker - probably because it is not setting the
boolean to false for each row - but might not be better).

Sub Test2()
Dim iLast_Row As Integer
Dim j As Long

iLast_Row = 32000

For j = 1 To iLast_Row
Application.StatusBar = "Row " & j
If Worksheets("Sheet1").Cells(j, 1) = Worksheets
("Sheet2").Cells(j, 1) And Worksheets("Sheet1").Cells(j,
2) = Worksheets("Sheet2").Cells(j, 2) Then
GoTo skip_it
Else
Worksheets("Sheet2").Cells(j, 3).Value = "XXXXX"
End If
skip_it:
Next

End Sub
 
Hi Alan

I don't think one loop will do it. Perhaps I should I stated that there are
about 30,000 rows on one sheet and about 32,000 rows on the other. And the
match ups are not on the same row.

thanks
Matt.
 
Hi Ron

That is the roughly the code I am using at the minute but as I said I takes
for ever. Your suggesting of sorting may have something in it. Perhaps I
could sort and delete matching rows as I go, maybe that would be faster. I
don't know I am not an expert at VBA and always end up with problems when I
delete rows. Although I not conviced that it cant be done with formulas as
on Chip Peasons page and they are so much faster.

Thanks
Matt
 
Matt,

Hopefully you're still around.. Your last post was a couple of days ago.

I've come across a function I've never seen before (and never had a need
for): ColumnDifferences.
Seeing it's potential for lookups, I thought again about your lookup
problem, and rewrote the solution.

I've no idea how quick it runs against 1000s of rows. I'm concerned that
the writing to Cells will be slow. Hopefully the lookup speed will help.

Would you please let me know how things go?


Sub testit()
Dim rng As Range, lngLastRow As Long, i As Long
Dim rngSource As Range, rngCompare As Range, rngResult As Range

With Sheet2
Set rngSource = .Cells(1, 1).Resize(.Cells(Rows.Count,
1).End(xlUp).Row, 2)
End With

With Sheet1
.Rows(1).Insert
Set rngCompare = .Cells(1, 1).Resize(.Cells(Rows.Count,
1).End(xlUp).Row, 2)

For Each rng In rngSource.Rows
.Cells(1, 1) = rng.Cells(1, 1)
.Cells(1, 2) = rng.Cells(1, 2)
On Error Resume Next
Set rngResult = AntiRange(rngCompare.Columns(1),
rngCompare.Columns(1).ColumnDifferences(.Cells(1, 1))).Offset(0, 1)
rngResult.Find rngResult.Cells(1, 1)
If Not Intersect(rngResult.FindNext, rngResult.Cells(1, 1)) Is
Nothing Then rng.Cells(1, 3).Value = "xXxXx"
Next
.Rows(1).Delete
End With
End Sub

'AntiRange of Jim Rech - MessageID:
<#[email protected]>
Function AntiRange(BigRg As Range, SmallRg As Range) As Range
Dim NewRg As Range, CurrCell As Range
For Each CurrCell In BigRg.Cells
If Intersect(CurrCell, SmallRg) Is Nothing Then
If NewRg Is Nothing Then
Set NewRg = CurrCell
Else
Set NewRg = Union(NewRg, CurrCell)
End If
End If
Next
Set AntiRange = NewRg
End Function


Rob
 
Back
Top