Excel VBA help

steviewonderpants

New Member
Joined
Oct 2, 2006
Messages
48
Hello all

I have one speadsheet with 3 tabs. Tab 1 contains around 800 lines of our master account and tab 2 contains a small number of these accounts. Tab 3 is blank. What I am looking to do is cross reference tabs 1 & 2 for recurring data. If any detail comes up more than once I'd like to copy the entire line from tab one and paste it into tab 3.

Is this possible... If so how??

Many thanks
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
Hi steviewonderpants,

Yes, this can be done in a VBA macro. But specifically how depends on what constitutes "recurring data". Is it recurring if some part or parts of a row (say, column A) on Tabs 1 and 2 are the same? Or do entire rows (i.e., all columns) of data have to match?

Damon
 

steviewonderpants

New Member
Joined
Oct 2, 2006
Messages
48
Hi Damon

Basically I have a master account list (Tab 1) and within this is a set of account numbers (column G) and on tab 2 there is a smaller list of account numbers (in column A) that I would like to cross reference against column G in tab 1. If any 'duplicate' fields are identified then I could like the entire line from tab 1 copied and pasted into tab 3

Cheers

Steve
 

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
Hi again stevie,

Here is a macro that I believe does what you describe:

Code:
Sub CrossRef()

   Dim Master     As Worksheet   'Tab 1
   Dim RefTab     As Worksheet   'Tab 2
   Dim NewTab     As Worksheet   'Tab 3
   Dim Cell       As Range
   Dim iRow       As Long
   Dim jRow       As Long
   
   Set Master = Worksheets(1)
   Set RefTab = Worksheets(2)
   Set NewTab = Worksheets(3)
   
   jRow = NewTab.Range("G65536").End(xlUp).Row
   
   For iRow = 2 To RefTab.Range("A65536").End(xlUp).Row
      Set Cell = Master.Range("G:G").Find(RefTab.Cells(iRow, "A"), Master.Range("G1"), xlValues, xlWhole)
      If Not Cell Is Nothing Then
         'matching account found--copy record to tab 3
         jRow = jRow + 1
         Cell.EntireRow.Copy Destination:=NewTab.Rows(jRow)
      End If
   Next iRow

End Sub

This macro should be placed in a standard macro module. This code assumes the tabs you were referring to were not necessarily the tab names, but rather the tab order. If further assumes that each tab has headings in row 1.

Keep Excelling.

Damon
 

steviewonderpants

New Member
Joined
Oct 2, 2006
Messages
48

ADVERTISEMENT

Damon

Many thanks for this. One problem that I have found is that it only seems to pick up the first record it finds. I know there are a number of duplicated items as I ran a pivot table report to flag the items appearing more than once.

Is it possible to 'loop' this macro so it finds multiple items on the sheet.

Thanks
Steve
 

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
Find and copy rows

Hi Stevie,

Unfortunitely I'm heading out of town for a week and don't have time to add that feature to the code before I go. If you can wait until I return I'll be happy to add it.

But perhaps some kind soul will step in and fill the gap. :)

Damon
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995

ADVERTISEMENT

Hi
On behalf of Damon
Code:
Sub CrossRef()

   Dim Master     As Worksheet   'Tab 1
   Dim RefTab     As Worksheet   'Tab 2
   Dim NewTab     As Worksheet   'Tab 3
   Dim Cell       As Range
   Dim iRow       As Long
   Dim jRow       As Long
   Dim ff As String
   
   Set Master = Worksheets(1)
   Set RefTab = Worksheets(2)
   Set NewTab = Worksheets(3)
   
   jRow = NewTab.Range("G65536").End(xlUp).Row
   
   For iRow = 2 To RefTab.Range("A65536").End(xlUp).Row
      Set Cell = Master.Range("G:G").Find(RefTab.Cells(iRow, "A"), Master.Range("G1"), xlValues, xlWhole)
      If Not Cell Is Nothing Then
         'matching account found--copy record to tab 3
         ff = Cell.Address
         Do
            jRow = jRow + 1
            Cell.EntireRow.Copy Destination:=NewTab.Rows(jRow)
            Set Cell = Master.Range("G:G").FindNext(Cell)
         Loop Until ff = Cell.Address
      End If
   Next iRow

End Sub
 

steviewonderpants

New Member
Joined
Oct 2, 2006
Messages
48
Hi

Many thanks for the 'loop' function in this but for some reason this does not appear to be working as I'd hoped. The macro only seems to be able to find the first duplicated field and not all of them. Is there something I am not doing right?

Thanks
Steve
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
How about this?
Code:
Sub CrossRef()

   Dim Master     As Worksheet   'Tab 1
   Dim RefTab     As Worksheet   'Tab 2
   Dim NewTab     As Worksheet   'Tab 3
   Dim Cell       As Range
   Dim iRow       As Long
   Dim jRow       As Long
   Dim dic As Object
   
   Set dic = CreateObject("Scripting.Dictionary")
   dic.CompareMode = vbTextCompre
   
   Set Master = Worksheets(1)
   Set RefTab = Worksheets(2)
   Set NewTab = Worksheets(3)
   
   jRow = NewTab.Range("G65536").End(xlUp).Row
   With Master
      For iRow = 2 To .Range("g" & Rows.Count).End(xlUp).Row
         If Not dic.exists(.Cells(iRow,"g").Value) Then dic.Add .Cells(iRow,"g").Value, Nothing
      Next
   End With
   With RefTab
      For iRow = 2 To .Range("a" & Rows.Count).End(xlUp).Row
         If dic.exists(.Cells(iRow,"a").Value) Then
            .Rows(iRow).Copy NewTab.Rows(jRow)
            jRow = jRow + 1
         End If
      Next
   End With
Set dic = Nothing
End Sub
edited: 16:49
 

steviewonderpants

New Member
Joined
Oct 2, 2006
Messages
48
Hi, I have tried to run this but the following field is coming back asking for a dubugger to be used

Then dic.Add, Nothing

This is highlighted in yellow within the VB editor


EDIT: OK the VB no longer needs to be debugged but now the info being returned is not the entire duplicated line from TAB 1

Thanks

Steve
 

Forum statistics

Threads
1,136,271
Messages
5,674,746
Members
419,525
Latest member
helensesc

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
Top