Combine two data sets and merge them into one table

**oddy73** · 03-31-2015, 03:59 PM

Hi,

I post this problem here, but no luck yet.

I have two different data sets but they have this shared ID which is the employee name.
I want to combine these two data sets and listing them by name in a table.

In the attachment I tried to portray my problem with the solution (combined table) I am looking for.

I tried the consolidate function, but i guess that this is not the solution. I guess I should use a advanced version of Vlookup function

Any suggestion is welcome

**xladept** · 03-31-2015, 05:45 PM

Try this:

Sub Oddy():     Dim DS1, DS2, CT, R As Range, D As Date, N As String, CTD As Date
Dim i As Long, j As Long, k As Long, H As Single, P1 As String, P2 As String, A As Single
        Set R = Cells.Find("Dataset 1"): DS1 = R.Offset(2, -1).CurrentRegion
        Set R = Cells.Find("Dataset 2"): DS2 = R.Offset(2, -1).CurrentRegion
        Set R = Cells.Find("Combined table"):
    CT = R.Offset(0, -2).Resize(UBound(DS1, 1) + UBound(DS2, 1), UBound(DS1, 2) + UBound(DS2, 2))
        Set R = R.Offset(0, -2).Resize(UBound(CT, 1), UBound(CT, 2)): CTD = CT(2, 3): k = 3
                                R.Offset(2).ClearContents
                        For i = 2 To UBound(DS1): D = DS1(i, 4)
                If Month(D) = Month(CTD) And Year(D) = Year(CTD) Then
                    N = DS1(i, 1): P1 = DS1(i, 2): H = DS1(i, 3)
                            For j = 2 To UBound(DS2)
                            If LCase(DS2(j, 1)) = LCase(N) Then
                            DS2(j, 1) = DS2(j, 1) & "*"
                            P2 = DS2(j, 2): A = DS2(j, 3)
                    k = k + 1: CT(k, 1) = N: CT(k, 2) = D: CT(k, 3) = P1
                            CT(k, 4) = H: CT(k, 5) = P2: CT(k, 7) = A
                            Exit For: End If: Next j
End If: Next i: R = CT: End Sub

**oddy73** · 04-01-2015, 05:21 AM

Thanks xladept,

It's a great starting point. May be it's my fault for not being clear enough. Your solution does not correctly use the second data set.
For example Alex has one instances in data set 1 and three instances data set 2. Currently your solution uses only the first entry of data set 2.

For Alex should the result in Combined table be like this:
combined_table.png
The Combined table will be used eventually for running reporting per person.

**xladept** · 04-01-2015, 03:23 PM

Hi Oddy,

I'm mulling it over - every other name had one for one?

Thanks for the rep!

**oddy73** · 04-01-2015, 03:38 PM

I don't understand what your question is. Perhaps the following picture will clear things up.
The final table can also be like this:

CombinedTable.jpg

Hopefully this will clear things up.
(you can also put empty rows after each name)

Thanks in advance!

I made a mistake in my previous post, sorry

**xladept** · 04-01-2015, 11:36 PM

Hey Oddy,

Are you telling me the whole story? Is your last sample the final one or can you post a more representative sample??

**oddy73** · 04-02-2015, 03:48 AM

Hi Xladept,

Yes I am telling you the whole story. With the help of someone else, we managed to get the result. It needs some testing but this is what I was asking:

Option Explicit
Option Compare Text
 
Sub Merge()
    Dim a, b, i As Long, ii As Long, iii As Long, ub1 As Long, ub2 As Long, n As Long, w
    b = [g4].CurrentRegion.Value
    With [a4].CurrentRegion
        a = [a4].CurrentRegion.Resize(UBound(b, 1) * .Rows.Count).Value
        a(1, 2) = "Holiday/sick": ub1 = .Rows.Count: ub2 = .Columns.Count
    End With
    a = Application.Index(a, Evaluate("row(1:" & UBound(a, 1) & ")"), [{1,4,2,3}])
    ReDim Preserve b(1 To UBound(b, 1), 1 To UBound(b, 2) + 1)
    b(1, 2) = "Projectname": b(1, 4) = "Subhours"
    b = Application.Index(b, Evaluate("row(1:" & UBound(b, 1) & ")"), [{1,2,4,3}])
    ReDim Preserve a(1 To UBound(a, 1), 1 To ub2 + UBound(b, 2) - 1)
    With CreateObject("System.Collections.ArrayList")
        For i = 1 To UBound(a, 1)
            ReDim w(1 To UBound(a, 2))
            For ii = 1 To ub2
                w(ii) = a(i, ii)
            Next
            If a(i, 1) <> "" Then
                For ii = 1 To UBound(b, 1)
                    If a(i, 1) = b(ii, 1) Then
                        For iii = 2 To UBound(b, 2)
                            w(ub2 + iii - 1) = b(ii, iii)
                        Next
                        b(ii, 1) = "": Exit For
                    End If
                Next
            End If
            .Add w
        Next
        For i = 1 To UBound(b, 1)
            If b(i, 1) <> "" Then
                For ii = .Count - 1 To 0 Step -1
                    If .Item(ii)(1) = b(i, 1) Then
                        ReDim w(1 To UBound(a, 2))
                        For iii = 2 To UBound(b, 2)
                            w(ub2 + iii - 1) = b(i, iii)
                        Next
                        .Insert ii + 1, w
                    End If
                Next
            End If
        Next
        [l18].Resize(.Count, UBound(a, 2)).Value = Application.Index(.ToArray, 0, 0)
    End With
End Sub

**xladept** · 04-02-2015, 03:50 PM

Well done

**xladept** · 04-03-2015, 09:02 PM

Try this:

Sub OddyX(): Dim DS1, DS2, CT, R As Range, D As Date, N As String, CTD As Date, A As Single
    Dim g As Long, i As Long, j As Long, k As Long, H As Single, P1 As String, P2 As String
        Set R = Cells.Find("Dataset 1"): DS1 = R.Offset(2, -1).CurrentRegion
        Set R = Cells.Find("Dataset 2"): DS2 = R.Offset(2, -1).CurrentRegion
        Set R = Cells.Find("Combined table"): k = 4
CT = R.Offset(0, -2).Resize(UBound(DS1, 1) + UBound(DS2, 1), UBound(DS1, 2) + UBound(DS2, 2))
        Set R = R.Offset(0, -2).Resize(UBound(CT, 1), UBound(CT, 2)): CTD = CT(2, 3)
                                R.Offset(3).ClearContents
                                
                        For i = 2 To UBound(DS1): g = k
            Do Until DS1(i, 1) <> "": i = i + 1: Loop: N = DS1(i, 1)
                    P1 = DS1(i, 2): H = DS1(i, 3): D = DS1(i, 4): DS1(i, 1) = ""
            CT(k, 1) = N: CT(k, 2) = D: CT(k, 3) = P1: CT(k, 4) = H: k = k + 1
                        For j = i + 1 To UBound(DS1)
                        If LCase(DS1(j, 1)) = LCase(N) Then
                    P1 = DS1(j, 2): H = DS1(j, 3): D = DS1(j, 4): DS1(j, 1) = ""
            CT(k, 1) = N: CT(k, 2) = D: CT(k, 3) = P1: CT(k, 4) = H: k = k + 1
                    End If: Next j
                        For j = 2 To UBound(DS2)
                        If LCase(DS2(j, 1)) = LCase(N) Then
                        P2 = DS2(j, 2): A = DS2(j, 3): DS2(j, 1) = ""
                        CT(g, 5) = P2: CT(g, 7) = A: g = g + 1
                        End If: Next j
                    If g > k Then k = g
                    k = k + 1
                    If k > UBound(CT) Then ReDim Preserve CT(k, UBound(CT, 2))
GetNext:                 Next i: R = CT: End Sub

Combine two data sets and merge them into one table

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Re: Combine two data sets and merge them into one table

Thread Information

Users Browsing this Thread

Similar Threads

Combine to sets of data

[SOLVED] Merge two data sets A & B into one

[SOLVED] How to Combine two sets of data in excel

Combine two sets of data

merge two data sets one unique

Bookmarks

Bookmarks

Posting Permissions