Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Wanet Telecoms Ltd on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Similarly to another couple posters 1

Status
Not open for further replies.
AlexIT

AlexIT

Technical User
Jul 27, 2001
802
US
Similarly to another couple posters, I have a SLOW macro to compare cells in one workbook against cells in another...I mean this kludge takes 5 hours to run on a fast machine.

Could someone point out the many ways I've programmed this worng?

Sub Comparison()

Application.ScreenUpdating = False

Dim uRow, dRow As Long
Dim ItemNo, j, i, h
Dim Path, Description, Revision, SheetSize As String

Workbooks("drawinglist.xls").Activate
Sheets(2).Select

dRow = Cells(7000, 1).End(xlUp).Row

Workbooks("ultralist.xls").Activate
Sheets(2).Select

uRow = Cells(15000, 1).End(xlUp).Row

h = 1
i = 1

For x = 1 To dRow
j = h
For y = 1 To uRow
If Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value = Workbooks("ultralist.xls").Sheets(2).Cells(y, 1).Value Then
ItemNo = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value
Path = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 2).Value
Description = Workbooks("ultralist.xls").Sheets(2).Cells(y, 2).Value
Revision = Workbooks("ultralist.xls").Sheets(2).Cells(y, 3).Value
SheetSize = Workbooks("ultralist.xls").Sheets(2).Cells(y, 4).Value
ThisWorkbook.Sheets(1).Cells(h, 1) = ItemNo
ThisWorkbook.Sheets(1).Cells(h, 2) = Description
ThisWorkbook.Sheets(1).Cells(h, 3) = Revision
ThisWorkbook.Sheets(1).Cells(h, 4) = SheetSize
ThisWorkbook.Sheets(1).Cells(h, 5) = Path
h = h + 1
End If
Next y
If j = h Then
ItemNo = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value
Path = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 2).Value
Description = "NOT IN ULTRALIST"
ThisWorkbook.Sheets(2).Cells(i, 1) = ItemNo
ThisWorkbook.Sheets(2).Cells(i, 2) = Description
ThisWorkbook.Sheets(2).Cells(i, 5) = Path
i = i + 1
End If

Next x
End Sub

Thanks for the help,
Alex
 
Sort by date Sort by votes
Code: 
Sub Comparison()

    'How many "Rows" are in the worksheets?
    'Use of the "With / End With" construct would eliminate a bit of redundant calculation
    'providing alais designations for the various worksheets would simplify some expressions
    
    Application.ScreenUpdating = False

    'Dimension Typing Does NOT apply to all items in the list.  Thus "uRow" is a variant
    Dim uRow, dRow As Long                                  'Not explicitly Typed
    Dim ItemNo, j, i, h                                     'Not explicitly Typed
    Dim Path, Description, Revision, SheetSize As String    'Not explicitly Typed

    Workbooks("drawinglist.xls").Activate
    Sheets(2).Select
    dRow = Cells(7000, 1).End(xlUp).Row
    
    Workbooks("ultralist.xls").Activate
    Sheets(2).Select
    uRow = Cells(15000, 1).End(xlUp).Row
    
    h = 1
    i = 1
    
    For x = 1 To dRow       'x is not decalred, and thus is type Variant
        j = h
        For y = 1 To uRow   'Y is not declared ...
            If Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value = Workbooks("ultralist.xls").Sheets(2).Cells(y, 1).Value Then

            'Why use dual assignment?  See below, use of "ItemNo" is just the Source for another assignment.
            ItemNo = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value

            Path = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 2).Value
            Description = Workbooks("ultralist.xls").Sheets(2).Cells(y, 2).Value
            Revision = Workbooks("ultralist.xls").Sheets(2).Cells(y, 3).Value
            SheetSize = Workbooks("ultralist.xls").Sheets(2).Cells(y, 4).Value

            'See above Why declare (and assign) ItemNo?
            'See above Use of With.  One Line as an example:
            With ThisWorkBook.Sheets(1)
                .Cells(h, 1) = ItemNo
            End With
            'End Example

            ThisWorkBook.Sheets(1).Cells(h, 1) = ItemNo
            ThisWorkBook.Sheets(1).Cells(h, 2) = Description
            ThisWorkBook.Sheets(1).Cells(h, 3) = Revision
            ThisWorkBook.Sheets(1).Cells(h, 4) = SheetSize
            ThisWorkBook.Sheets(1).Cells(h, 5) = Path
            h = h + 1
            End If

        Next y


        If j = h Then
            ItemNo = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value
            Path = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 2).Value
            Description = "NOT IN ULTRALIST"
            ThisWorkBook.Sheets(2).Cells(i, 1) = ItemNo
            ThisWorkBook.Sheets(2).Cells(i, 2) = Description
            ThisWorkBook.Sheets(2).Cells(i, 5) = Path
            i = i + 1
        End If
        
    Next x
End Sub

MichaelRed
m.red@att.net

Searching for employment in all the wrong places
 
Upvote 0 Downvote
This is a minor comment and unfortunately it won't address the speed of your program, but I've seen people using the Dim statements incorrectly and just thought I'd mention it.

You have to indicate "As" for each variable, otherwise it will be a variant.

So....
Dim uRow, dRow As Long
...only results in dRow assigned as long.

Code: 
Sub test()
Dim i, j As Long
Dim a, b As String
Debug.Print TypeName(i), TypeName(j), TypeName(a), TypeName(b)
End Sub

Result:
Empty Long Empty String

No biggie, and hopefully others more experienced than I can help address your efficiency question.

Dave.
 
Upvote 0 Downvote
I always thought the dimension applied to the whole string! Learn something every day.

Ok, so if I read you two correctly I should use something closer to this (I pulled the second IF function because it wasn't as needed) :


Sub Comparison()

Application.ScreenUpdating = False

Dim uRow As Long
Dim dRow As Long
Dim ItemNoD As Integer
Dim ItemNoU As Integer
Dim i As Integer
Dim v As Integer
Dim w As Integer
Dim x As Integer
Dim y As Integer
Dim Path As String
Dim Description As String
Dim Revision As String
Dim SheetSize As String

u = 9629 'Number of rows expected in ultralist
v = 6084 'Number of rows expected in drawinglist

i = 1

For x = 1 To v
ItemNoD = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value
Path = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 2).Value

For y = 1 To u

ItemNoU = Workbooks("ultralist.xls").Sheets(2).Cells(y, 1).Value
Description = Workbooks("ultralist.xls").Sheets(2).Cells(y, 2).Value
Revision = Workbooks("ultralist.xls").Sheets(2).Cells(y, 3).Value
SheetSize = Workbooks("ultralist.xls").Sheets(2).Cells(y, 4).Value

If ItemNoD = ItemNoU Then
ThisWorkbook.Sheets(1).Cells(h, 1) = ItemNoD
ThisWorkbook.Sheets(1).Cells(h, 2) = Description
ThisWorkbook.Sheets(1).Cells(h, 3) = Revision
ThisWorkbook.Sheets(1).Cells(h, 4) = SheetSize
ThisWorkbook.Sheets(1).Cells(h, 5) = Path
h = h + 1
End If

Next y

Next x

End Sub
 
Upvote 0 Downvote
Yes you can do it line-by-line or as an alternative, you can still stack them if you want, just need to add the "As" part along with each variable.

Code: 
Dim i As Integer, j As Integer, a As String


Dave.
 
Upvote 0 Downvote
For some reason if I dimension the ItemNo(s) as integer I get a out of range error, these are six digit integers so is there a limitation I don't know of? If these were truncated from a string variable would this cause the out of range?

Thanks,
Alex
 
Upvote 0 Downvote
Instead of accessing the same cells repeatedly, try extracting the values to arrays, and then refer to the arrays.
Dim aItemNoU() As Long
Dim aDescription() As String
Dim aRevision() As String
Dim aSheetSize As String
reDim aItemNoU(u) As Long
reDim aDescription(u) As String
reDim aRevision(u) As String
reDim aSheetSize(u) As String

For y = 1 To u
aItemNoU(y) = Workbooks("ultralist.xls").Sheets(2).Cells(y, 1).Value
aDescription(y) = Workbooks("ultralist.xls").Sheets(2).Cells(y, 2).Value
aRevision(y) = Workbooks("ultralist.xls").Sheets(2).Cells(y, 3).Value
aSheetSize(y) = Workbooks("ultralist.xls").Sheets(2).Cells(y, 4).Value
Next y

For x = 1 To v
ItemNoD = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 1).Value
Path = Workbooks("drawinglist.xls").Sheets(2).Cells(x, 2).Value
For y = 1 To u
If ItemNoD = aItemNoU(y) Then
ThisWorkbook.Sheets(1).Cells(h, 1) = ItemNoD
ThisWorkbook.Sheets(1).Cells(h, 2) = aDescription(y)
ThisWorkbook.Sheets(1).Cells(h, 3) = aRevision(y)
ThisWorkbook.Sheets(1).Cells(h, 4) = aSheetSize(y)
ThisWorkbook.Sheets(1).Cells(h, 5) = aPath(y)
h = h + 1
End If
Next y
Next x



Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
 
Upvote 0 Downvote
I gather that there may be duplicate ItemNoUs. If not, you should EXIT FOR when you find a match.

Also, if the U cells are in ItemnoU sequence then a Binary Search will be much faster and duplicates can be handled by backing up from the found Y until Y < 1 or an unequal ItemNo and then adding 1 to Y.

dim yhi as long
dim yLo as long
dim z as long
yHi = u
yLo = 1

For x = 1 To v
ItemNoD = Workbooks(&quot;drawinglist.xls&quot;).Sheets(2).Cells(x, 1).Value
Path = Workbooks(&quot;drawinglist.xls&quot;).Sheets(2).Cells(x, 2).Value
Do
y = (ylo + yhi) \ 2
z = aItemNoU(y) - ItemNoD
Select Case Z
Case 0
exit do
Case Is < 0
yLo = y + 1
Case else
yHi = y - 1
End Select
if yLo > yhi then
y = 0
exit do
end if
Loop

If y <> 0 Then
' Back up to first in group.
For Y = Y To 1 Step -1
if aItemno(y) <> ItemNoD then exit for
Next
For y = y + 1 To U
if aItemno(y) <> ItemNoD then exit for
ThisWorkbook.Sheets(1).Cells(h, 1) = ItemNoD
ThisWorkbook.Sheets(1).Cells(h, 2) = aDescription(y)
ThisWorkbook.Sheets(1).Cells(h, 3) = aRevision(y)
ThisWorkbook.Sheets(1).Cells(h, 4) = aSheetSize(y)
ThisWorkbook.Sheets(1).Cells(h, 5) = aPath(y)
h = h + 1
Next
End If
Next x


Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
 
Upvote 0 Downvote
I think I am understanding the use of the array above, I should be able to pre-fill the ItemNoU array, then only open the ItemNoD cells one time each to compare to the array...

Yes, there are duplicate ItemNo's in both lists. Both the ItemNo cells are pre-sorted (ascending), so the binary approach should work, but I will still need to consider the case where there is no match for ItemNoD in Array ItemNoU too (my IF no match found condition:)

Do you think this could be done before the &quot;Exit For&quot; from the <> conditional? (Make the &quot;No Match&quot; a positive condition?)

Thanks,
Alex

 
Upvote 0 Downvote
Sure, but in your code you did nothing with NOMATCH.
If y = 0 Then
....NOMATCH STUFF
Else
' Back up to first in group.
For Y = Y To 1 Step -1
if aItemno(y) <> ItemNoD then exit for
Next
For y = y + 1 To U
if aItemno(y) <> ItemNoD then exit for
ThisWorkbook.Sheets(1).Cells(h, 1) = ItemNoD
ThisWorkbook.Sheets(1).Cells(h, 2) = aDescription(y)
ThisWorkbook.Sheets(1).Cells(h, 3) = aRevision(y)
ThisWorkbook.Sheets(1).Cells(h, 4) = aSheetSize(y)
ThisWorkbook.Sheets(1).Cells(h, 5) = aPath(y)
h = h + 1
Next
End If





Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
 
Upvote 0 Downvote
I haven't used arrays in VB before, why the ReDim command?

If i put all this advice together correctly, the final version should be:

dim u as integer
dim v as integer
dim h as integer
dim i as integer
dim x as integer
dim y as integer

dim yhi as long
dim yLo as long
dim z as long
Dim aItemNoU() As Long

Dim NoMatch As String
Dim Path As String
Dim aDescription() As String
Dim aRevision() As String
Dim aSheetSize() As String

reDim aItemNoU(u) As Long

reDim aDescription(u) As String
reDim aRevision(u) As String
reDim aSheetSize(u) As String

h = 1
i = 1

u = 9629 'Number of rows expected in ultralist
v = 6084 'Number of rows expected in drawinglist

NoMatch = &quot;NOT IN ULTRALIST&quot;

For y = 1 To u
aItemNoU(y) = Workbooks(&quot;ultralist.xls&quot;).Sheets(2).Cells(y, 1).Value
aDescription(y) = Workbooks(&quot;ultralist.xls&quot;).Sheets(2).Cells(y, 2).Value
aRevision(y) = Workbooks(&quot;ultralist.xls&quot;).Sheets(2).Cells(y, 3).Value
aSheetSize(y) = Workbooks(&quot;ultralist.xls&quot;).Sheets(2).Cells(y, 4).Value
Next y

yHi = u
yLo = 1

For x = 1 To v
ItemNoD = Workbooks(&quot;drawinglist.xls&quot;).Sheets(2).Cells(x, 1).Value
Path = Workbooks(&quot;drawinglist.xls&quot;).Sheets(2).Cells(x, 2).Value
Do
y = (ylo + yhi) \ 2
z = aItemNoU(y) - ItemNoD
Select Case Z
Case 0
exit do
Case Is < 0
yLo = y + 1
Case else
yHi = y - 1
End Select
if yLo > yhi then
y = 0
exit do
end if
Loop

If y = 0 Then
ThisWorkbook.Sheets(2).Cells(i, 1) = ItemNoD
ThisWorkbook.Sheets(2).Cells(i, 2) = NoMatch
ThisWorkbook.Sheets(2).Cells(i, 3) = Path
i = i + 1

Else
' Back up to first in group.
For Y = Y To 1 Step -1
if aItemno(y) <> ItemNoD then exit for
Next
For y = y + 1 To U
if aItemno(y) <> ItemNoD then exit for
ThisWorkbook.Sheets(1).Cells(h, 1) = ItemNoD
ThisWorkbook.Sheets(1).Cells(h, 2) = aDescription(y)
ThisWorkbook.Sheets(1).Cells(h, 3) = aRevision(y)
ThisWorkbook.Sheets(1).Cells(h, 4) = aSheetSize(y)
ThisWorkbook.Sheets(1).Cells(h, 5) = Path
h = h + 1
Next
End If
Next x
 
Upvote 0 Downvote
I made one small mistake when I put the advice together, after I realized that it ran in about 25 seconds, and I got my list exactly as I needed. Thanks!!

Alex
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
859
combo
combo
rf92d
  • Locked
  • Question
Hi referring to thread707-107529
Replies
0
Views
588
rf92d
rf92d
rf92d
  • Locked
  • Question
hi referring to thread707-103495
Replies
9
Views
869
Andrzejek
Andrzejek
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
2K
remeng
remeng
corbinap
  • Locked
  • Question
Do loop to find text and add verbiage if found in another column
Replies
2
Views
291
corbinap
corbinap

Part and Inventory Search

Sponsor

Back
Top