Comparing columns in two workbooks and pasting the matching rows in a new worksheet

shrimic

New Member
Joined
Feb 9, 2012
Messages
1
A brief overview of the problem at hand:
There are two workbooks 'ACP.xlsm' and 'Reference.xlsm'. The code must compare a value (from 3rd row) in column A of ACP.xlsm workbook to a value (rows from A2 of) in column A of Reference.xlsm work book or column B, C in that order. If a match is found then it should offset one step from column A in ACP.xlsm to coumn B in ACP.xlsm and check for a value "WS Groups Totals:" in that column and when it finds the first instance of the value, it should stop checking and copy the range of rows from the row when Column A in ACP.xlsm matched with a value in Column (A or B or C ) in Reference .xlsm and paste it in separate worksheet in ACP.xlsm. I have written a code for the purpose but when I run this code it keeps on throwing me the error that subscript is out of range (Error:9)...can you please help me run this code or suggest a better code...I am a beginner and I am at my wits end...thank you...I have attached my data files for your reference in case my description is not clear...
My code:
Option Explicit
Sub GetMatches()
Dim PartRngWorkbook1Sheet1 As Range, PartRngWorkbook2Sheet1 As Range
Dim lastRowWorkbook1Sheet1 As Long, lastRowWorkbook2Sheet1 As Long
Dim cl As Range, rng As Range
Dim LSearchRow As Integer
Dim LCopyToRow As Integer

lastRowWorkbook1Sheet1 = Workbooks("ACP.xlsm").Worksheets("Sheet1").Range("A65536").End(xlUp).Row
Set PartRngWorkbook1Sheet1 = Workbooks("ACP.xlsm").Worksheets("Sheet1").Range("A3:A" & lastRowWorkbook1Sheet1)

lastRowWorkbook2Sheet1 = Workbooks("Reference.xlsm").Worksheets("Sheet1").Range("A65536").End(xlUp).Row
Set PartRngWorkbook2Sheet1 = Workbooks("Reference.xlsm").Worksheets("Sheet1").Range("A2:A" & lastRowWorkbook2Sheet1)
For Each cl In PartRngWorkbook1Sheet1
For Each rng In PartRngWorkbook2Sheet1
If cl = rng Then
LSearchRow = ActiveCell.Row 'Have a doubt here
LCopyToRow = Workbooks("ACP.xlsm").Worksheets("Sheet2").Rows(1)
If Range("cl.offset(0,1)" & CStr(LSearchRow)).Value = "WS Group Totals:" Then
Rows(CStr(ActiveCell.Row) & ":" & CStr(LSearchRow)).Select 'Have a doubt here
Selection.Copy

Workbooks("ACP.xlsm").Worksheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

LCopyToRow = Workbooks("ACP.xlsm").Worksheets("Sheet2").End(xlUp).Row + 1

Workbooks("ACP.xlsm").Worksheets("Sheet1").Select
End If

Do Until Range("cl.offset(0,1)" & CStr(LSearchRow)).Value = "WS Group Totals:"
LSearchRow = LSearchRow + 1
Loop

Else
If cl = rng.Offset(0, 1) Then
LSearchRow = ActiveCell.Row 'Have a doubt here
LCopyToRow = Workbooks("ACP.xlsm").Worksheets("Sheet3").Rows(1)
If Range("cl.offset(0,1)" & CStr(LSearchRow)).Value = "WS Group Totals:" Then
Rows(CStr(ActiveCell.Row) & ":" & CStr(LSearchRow)).Select 'Have a doubt here
Selection.Copy

Workbooks("ACP.xlsm").Worksheets("Sheet3").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

LCopyToRow = Workbooks("ACP.xlsm").Worksheets("Sheet3").End(xlUp).Row + 1

Workbooks("ACP.xlsm").Worksheets("Sheet1").Select
End If

Do Until Range("cl.offset(0,1)" & CStr(LSearchRow)).Value = "WS Group Totals:"
LSearchRow = LSearchRow + 1
Loop

Else
If cl = rng.Offset(0, 2) Then
LSearchRow = ActiveCell.Row 'Have a doubt here
LCopyToRow = Workbooks("ACP.xlsm").Worksheets("Sheet4").Rows(1)
If Range("cl.offset(0,1)" & CStr(LSearchRow)).Value = "WS Group Totals:" Then
Rows(CStr(ActiveCell.Row) & ":" & CStr(LSearchRow)).Select 'Have a doubt here
Selection.Copy

Workbooks("ACP.xlsm").Worksheets("Sheet4").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

LCopyToRow = Workbooks("ACP.xlsm").Worksheets("Sheet4").End(xlUp).Row + 1

Workbooks("ACP.xlsm").Worksheets("Sheet1").Select
End If

Do Until Range("cl.offset(0,1)" & CStr(LSearchRow)).Value = "WS Group Totals:"
LSearchRow = LSearchRow + 1
Loop
Else
Print "New Workstation group found in Workbook1"
End If
End If
End If


Next rng

Next cl


End Sub
 
Last edited:

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Forum statistics

Threads
1,215,202
Messages
6,123,625
Members
449,109
Latest member
Sebas8956

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top