Comparing two ranges of numbersSolved/Closed

Question

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.
"

Configuration: Windows XP / Internet Explorer 8.0

RWomanizer · Answer

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

ChrisCoR · Answer

Thank you very much!

RWomanizer · Answer

You are most welcomed

ChrisCoR · Answer

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

RWomanizer · Answer

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

Comparing two ranges of numbers

5 responses

Similar discussions

Subscribe To Our Newsletter!