copy two Columns into one and remove duplicates

[vew32]

i have two sets of data, both have a Column called Job number. In the second list there may be multiply instances of the job number. Also in the second instance of data there may be Job numbers that do not appear on the first list.

My aim is to merge all the data from both lists into one as automatically as possible. Both lists are updates daily.

My Line of thinking is to get the one Job number list and use Vlookup or sum product or sum if to do the rest

to get the Job numbers as one list i am trying trying to use the following VBA called from a button click

Private Sub CommandButton1_Click()
    Sheets("JOBSUM_DATA").Select
    Range("JOBSUMDATA[Job Number]").Select
    Selection.Copy
    
    Sheets("SUM_DATA").Select
    Range("SUMDATA[Job Number]").Select
    ActiveSheet.Paste

    Sheets("INCOME_DATA").Select
    Range("INCOMEDATA[Transaction Group]").Select
    Selection.Copy

    Sheets("SUM_DATA").Select
    Range("SUMDATA[Job Number]").Select
    ActiveSheet.Paste

    ActiveSheet.Range("SUMDATA[#All]").RemoveDuplicates Columns:=1, Header _
            :=xlYes
End Sub

any ideas why it wont work??

thanks

[111StepsAhead]

Do you have an example workbook?

[arlu1201]

What do you mean by - it doesnt work? Are you getting any error?

Also, you are pasting it in the same named range. Wont it overwrite the data?

[arlu1201]

Try this code without named ranges.

Option Explicit

Private Sub CommandButton1_Click()
Dim lrow As Long

lrow = Worksheets("JOBSUM_DATA").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("JOBSUM_DATA").Range("A2:A" & lrow).Copy Worksheets("SUM_DATA").Range("A2")

lrow = Worksheets("INCOME_DATA").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("INCOME_DATA").Range("A2:A" & lrow).Copy Worksheets("SUM_DATA").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

Worksheets("SUM_DATA").Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlYes

End Sub

Put this code in a standard module.

[vew32]

cant remember the old code error but with the above i get this error

subscript out of range

here is the excel document

Job summary template.xlsm

thanks for looking

[vew32]

old error with original code is method range of object _worksheet failed

hope that helps

i don't want to over write data but append to the bottom before dedicating it

[vew32]

i have managed to get a code working for removing duplicates from the table column

Private Sub CommandButton2_Click()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through.
iListCount = Sheets("SUMMARY DATA").Range("SUMDATA[Job Number]").Rows.Count
Sheets("SUMMARY DATA").Range("SUMDATA[Job Number]").Select
' Loop until end of records.
Do Until ActiveCell = ""
   ' Loop through records.
   For iCtr = 1 To iListCount
      ' Don't compare against yourself.
      ' To specify a different column, change 1 to the column number.
      If ActiveCell.Row <> Sheets("SUMMARY DATA").Cells(iCtr, 1).Row Then
         ' Do comparison of next record.
         If ActiveCell.Value = Sheets("SUMMARY DATA").Cells(iCtr, 1).Value Then
            ' If match is true then delete row.
            Sheets("SUMMARY DATA").Cells(iCtr, 1).Delete xlShiftUp
               ' Increment counter to account for deleted row.
               iCtr = iCtr + 1
         End If
      End If
   Next iCtr
   ' Go to next record.
   ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

now i just need a code to add to columns together under one the run the above

any ideas?

[arlu1201]

Try this code. It creates a temporary sheet called Temp where the columns are merged. It removes duplicates and then copies the contents to the SUMMARY DATA tab.

Option Explicit

Private Sub CommandButton1_Click()
Dim lrow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not Evaluate("ISREF(Temp!A1)") Then
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Temp"
End If

lrow = Worksheets("JOBSUM_DATA").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("JOBSUM_DATA").Range("A2:A" & lrow).Copy Worksheets("Temp").Range("A2")

lrow = Worksheets("INCOME_DATA").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("INCOME_DATA").Range("A2:A" & lrow).Copy Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

With Worksheets("Temp")
    .Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A2:A" & lrow).Copy Worksheets("SUMMARY DATA").Range("A2")
    .Delete
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[vew32]

tweaked a little as second list job number is in column B

but this works perfectly

many thanks

Option Explicit

Private Sub CommandButton3_Click()
Dim lrow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not Evaluate("ISREF(Temp!A1)") Then
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Temp"
End If

lrow = Worksheets("JOBSUM_DATA").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("JOBSUM_DATA").Range("A2:A" & lrow).Copy Worksheets("Temp").Range("A2")

lrow = Worksheets("INCOME_DATA").Range("B" & Rows.Count).End(xlUp).Row
Worksheets("INCOME_DATA").Range("B2:B" & lrow).Copy Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

With Worksheets("Temp")
    .Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A2:A" & lrow).Copy Worksheets("SUMMARY DATA").Range("A2")
    .Delete
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[arlu1201]

Am glad it worked.