Comparing two ranges of numbers [Solved/Closed]

Report
-
Posts
368
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
-
Hello Everyone,

Let me first say I'm very much an amateur with VBA code, but I have been using examples I have seen online to cobble together the following code....

Sub CompareExpendables()
'This macro checks all of the cells in one column on sheet 1(expendables)
'against one column on sheet 2(on hand inventory) and creates a new sheet
'showing all of the items that appear on both

    
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1row As Integer 
    Dim sh2row As Integer 
    Dim sh1col As Integer 
    Dim sh2col As Integer 
    Dim rng1ct As Range   
    Dim rng2ct As Range
    Dim row1 As Range
    Dim row2 As Range
    
    Set sh1 = ActiveWorkbook.Sheets(1)
    Set sh2 = ActiveWorkbook.Sheets(2)
    sh1row = sh1.Range("a800").End(xlUp).Row
    sh1col = sh1.Range("a800").End(xlToLeft).Column
    Set rng1ct = sh1.Range("a2").Resize(sh1row, sh1col)
    sh2row = sh2.Range("b2000").End(xlUp).Row
    sh2col = sh2.Range("b2000").End(xlToLeft).Column
    Set rng2ct = sh2.Range("b2").Resize(sh2row, sh2col)
    Set row1 = sh1.Cells(2, 1)
    Set row2 = sh2.Cells(2, 2)
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    
    For Each row1 In rng1ct
        For Each row2 In rng2ct
            If row2 = row1 Then
                row2.EntireRow.Copy Destination:=Worksheets(3).Range("a1", 1).Offset(1, 0)
            End If
        Next row2
    Next row1
    
    
End Sub


The intent of this code is to compare two worksheets in a single workbook and find matches, which will then be printed in a worksheet that will show all of the information
from the second worksheet. The code is probably very inefficient and sloppy, but I'm teaching myself as I go, so forgive my poor coding skills... The main issue I'm having right now is with the line
row2.EntireRow.Copy Destination:=Worksheets(Worksheets(Count)).Range(1, 1).RowAll.Offset(1, 0)
It tells me that I have a subscript out of range. Oh, this is also done in Excel 2003. I'm sure that is not the only problem with my code, but that is the only one blaring at me. Thank you in advance for your time and assistance.
"

5 replies

Posts
368
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
120
Hi ChrisCoR,

you can use VLOOKUP for the required result instead of macro.

anyway the new code after correction is as:

hope it will helps you.

Sub CompareExpendables1()
'This macro checks all of the cells in one column on sheet 1(expendables)
'against one column on sheet 2(on hand inventory) and creates a new sheet
'showing all of the items that appear on both

    
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1row As Integer
    Dim sh2row As Integer
    Dim sh1col As Integer
    Dim sh2col As Integer
    Dim rng1ct As Range
    Dim rng2ct As Range
    Dim row1 As Range
    Dim row2 As Range
    
    Set sh1 = ActiveWorkbook.Sheets(1)
    Set sh2 = ActiveWorkbook.Sheets(2)
    sh1row = sh1.Range("a" & Rows.Count).End(xlUp).Row
    sh1col = sh1.Range("a" & Columns.Count).End(xlToLeft).Column
    Set rng1ct = sh1.Range("a2").Resize(sh1row, sh1col)
    sh2row = sh2.Range("a" & Rows.Count).End(xlUp).Row
    sh2col = sh2.Range("a" & Columns.Count).End(xlToLeft).Column
    Set rng2ct = sh2.Range("b2").Resize(sh2row, sh2col)
    'Set row1 = sh1.Cells(2, 1)
    'Set row2 = sh2.Cells(2, 2)
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    
    For Each row1 In rng1ct
        For Each row2 In rng2ct
            If row2 = row1 Then
                row2.EntireRow.Copy Destination:=Worksheets(3).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next row2
    Next row1
    
    
End Sub
Thank you very much!
Posts
368
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
120
You are most welcomed
I looked over the VLOOKUP option, and I needed this to be usable with just a couple clicks(my coworkers on this project aren't as comfortable with computers as I am). I added a little bit of code to assist with formatting of the new spreadsheet, but its working perfectly! :)

Sub CompareExpendables()
'This macro checks all of the cells in one column on sheet 1(expendables)
'against one column on sheet 2(on hand inventory) and creates a new sheet
'showing all of the items that appear on both

    
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1row As Integer
    Dim sh2row As Integer
    Dim sh1col As Integer
    Dim sh2col As Integer
    Dim rng1ct As Range
    Dim rng2ct As Range
    Dim row1 As Range
    Dim row2 As Range
    
    Set sh1 = ActiveWorkbook.Sheets(1)
    Set sh2 = ActiveWorkbook.Sheets(2)
    sh1row = sh1.Range("a" & Rows.Count).End(xlUp).Row
    sh1col = sh1.Range("a" & Columns.Count).End(xlToLeft).Column
    Set rng1ct = sh1.Range("a2").Resize(sh1row, sh1col)
    sh2row = sh2.Range("b" & Rows.Count).End(xlUp).Row
    sh2col = sh2.Range("b" & Columns.Count).End(xlToLeft).Column
    Set rng2ct = sh2.Range("b2").Resize(sh2row, sh2col)
        
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    sh2.Range("a1:l1").Copy Destination:=Worksheets(3).Range("a1:l1")
    Worksheets(3).Columns("A:A").ColumnWidth = 7
    Worksheets(3).Columns("B:B").ColumnWidth = 20
    Worksheets(3).Columns("C:C").ColumnWidth = 64
    Worksheets(3).Columns("L:L").ColumnWidth = 12.2
        
    For Each row1 In rng1ct
        For Each row2 In rng2ct
            If row1 = row2 Then
                row2.EntireRow.Copy Destination:=Worksheets(3).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next row2
    Next row1
    
    
End Sub 
Posts
368
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
120
You can use this code after for loop.
Worksheets(3).Range("A1:L1").Select 
Selection.EntireColumn.AutoFit 


instead of these multiple lines

Worksheets(3).Columns("A:A").ColumnWidth = 7
Worksheets(3).Columns("B:B").ColumnWidth = 20
Worksheets(3).Columns("C:C").ColumnWidth = 64
Worksheets(3).Columns("L:L").ColumnWidth = 12.2