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

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
I don't know what kind of error you are getting though
try

Code:
Sub CrossRef()

   Dim Master     As Worksheet   'Sheet1
   Dim RefTab     As Worksheet   'Sheet2
   Dim NewTab     As Worksheet   'Sheet3
   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 = Sheet2
   Set RefTab = Sheet1
   Set NewTab = Sheet3
    
   jRow = NewTab.Range("G65536").End(xlUp).Row
   With Master
      For iRow = 1 To .Range("g" & Rows.Count).End(xlUp).Row
         If Not dic.exists(.Cells(iRow, "g").Value) Then dic.Add .Cells(iRow, "g").Value, iRow
      Next
   End With
   With RefTab
      For iRow = 1 To .Range("a" & Rows.Count).End(xlUp).Row
         If dic.exists(.Cells(iRow, "a").Value) Then
            Master.Cells(dic(.Cells(iRow,"a").Value,"a").EntireRow.Copy NewTab.Rows(jRow)
            jRow = jRow + 1
         End If
      Next
   End With
Set dic = Nothing
End Sub
 
Upvote 0
you can also try this one, with a little tweak from Damon's code.
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
      With Master.Columns("g")
      Set Cell = .Find(RefTab.Cells(iRow, "A"), , , xlWhole)
      If Not Cell Is Nothing Then
      f = Cell.Address
      Do
         'matching account found--copy record to tab 3
         jRow = jRow + 1
         Cell.EntireRow.Copy Destination:=NewTab.Rows(jRow)
    Set Cell = .FindNext(Cell)
    Loop Until f = Cell.Address
      End If
      End With
   Next iRow

End Sub
 
Upvote 0
Hi Jindon

I am getting a compile error: Syntax error

The whole line is red in the VB

Thanks

Steve

PS. I could email the spreadsheet over if that is any help.
 
Upvote 0
you can also try this one, with a little tweak from Damon's code.
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
      With Master.Columns("g")
      Set Cell = .Find(RefTab.Cells(iRow, "A"), , , xlWhole)
      If Not Cell Is Nothing Then
      f = Cell.Address
      Do
         'matching account found--copy record to tab 3
         jRow = jRow + 1
         Cell.EntireRow.Copy Destination:=NewTab.Rows(jRow)
    Set Cell = .FindNext(Cell)
    Loop Until f = Cell.Address
      End If
      End With
   Next iRow

End Sub

This is exactly what I wrote in the dirst place, but he doesn't like it...
 
Upvote 0
try the code above, you mentioned before that it will work but only one record is found.
 
Upvote 0
Is this only 1 line is found or every 1 item that features on tab 1 & 2 is found?

if you have "aaa" in tab2, it will find records in columnA of tab1, all the records found for "aaa" will be copied to tab3.
 
Upvote 0
OK, that is along the lines I am thinking of but ideally if there were 3 records of AAA I would need all of them moved. There is also many other duplicated lines that I need moving also
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,297
Members
448,564
Latest member
ED38

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