Merge data and delete duplicates VBA

[fodsved]

Hi all,

I am trying to build a tool in excel that can simulate and give an overview of packing plans, but i am having trouble getting a "timeline" to work. The sheets with the timeline are imported based on choice and will change in how many are imported. It needs to be VBA, the persons who will be using this tool, should just press the macro button and wait for the magic.

I would like to merge the timelines from each sheet and delete duplicates.

example
sht1:
A: 1 2 3 4 5 6

sht2:
A: 6 7 8 9

sht3:
A: 7 8 9 10 11 12

Mastersheet:
1 2 3 4 5 6 7 8 9 10 11 12

i really hope someone can help me, i have tried google and youtube, but havent found anything i was able to use in my case

 

[fodsved]

Better example on my data.

 

[Akuini]

1. Do you only have 1 row of data in each sheet?
2. What are the actual sheet names?

Note:
Instead of uploading an image, there are 2 proper ways to post a table/range, i.e:
1. Copy-paste the range directly to the reply box (but without the column letter & the row number).
2. Using the xl2bb add-in (this is the best way). You can download it by clicking the XL2BB icon in the reply window.

 

[fodsved]

Yes, only 1 row in each of the input sheets.

sheetnames:
Master (where output should be)
sht1 (input)
sht2 (input)
sht3 (input)

 

[Akuini]

Try this:
Sheet Master must be the active sheet when you run the code:

Sub a1121175a()
'https://www.mrexcel.com/board/threads/merge-data-and-delete-duplicates-vba.1121175/
Dim d As Object
Dim x, y
Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For Each x In Array("sht1", "sht2", "sht3")
    With Sheets(x)
        For Each y In .Range("A1", .Cells(1, .Columns.count).End(xlToLeft)).Value
            d(y) = Empty
        Next
    End With
Next

Range("A1").Resize(1, d.count) = d.Keys
End Sub

 

[fodsved]

Thanks alot Akuini, this works beautifully for this example, but its no dynamic
It will vary on how many of the input sheets will be imported into the workbook, sometimes it will be 2 sheets and sometimes it will be 7 etc.
i might havent been clear enough in my problem describtion.

would it be possible to integrate the code into something like this:

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Master" Then
your magic code

end if

next

 

[Akuini]

OK, try this:

Sub a1121175b()
'https://www.mrexcel.com/board/threads/merge-data-and-delete-duplicates-vba.1121175/
Dim d As Object
Dim x, y
Dim ws As Worksheet

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For Each ws In Worksheets
    If ws.Name <> "Master" Then
    With ws
        For Each y In .Range("A1", .Cells(1, .Columns.count).End(xlToLeft)).Value
            d(y) = Empty
        Next
    End With
    End If
Next

Range("A1").Resize(1, d.count) = d.Keys
End Sub

 

[fodsved]

It works, only problem now is that it is not in order from lowest to highest value, but i can fix that myself

But a huge thanks for your time and help, i've been struggling with this part of my workbook for days and i wouldnt have been able to solve this without your help!

 

[Akuini]

It works, only problem now is that it is not in order from lowest to highest value

Try this:

Sub a1121175c()
'https://www.mrexcel.com/board/threads/merge-data-and-delete-duplicates-vba.1121175/
Dim d As Object
Dim x, y
Dim ws As Worksheet
Dim c As Range
Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For Each ws In Worksheets
    If ws.Name <> "Master" Then
    With ws
        For Each y In .Range("A1", .Cells(1, .Columns.count).End(xlToLeft)).Value
            d(y) = Empty
        Next
    End With
    End If
Next

Set c = Range("A1").Resize(1, d.count)
c = d.Keys
c.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight

End Sub

 

[fodsved]

Again, thanks alot Akuini, you have been a great help!