concatenat data's tables

Y

yuki

New member
Joined
Nov 5, 2014
Messages
4
Reaction score
0
Points
0
Hello at all,


I would like help for concatenation data of 3 tables.
The first table data is entered manually.

The second and third table are a result of the first table (i use a macro for this).


I would like to concatenate in new worksheet the data of this tables in columns as in the attachment.


Thank for your help.

View attachment Test.xls
 
Last edited:
Use a recursive function. Haven't finished the Input Output but you should be able to complete it from this
Also must make sure that the last column is not a blank column

Code: 
'you could pass this along but coding in a rush
Public iRows As Long, iCols As Long, iSol As Long
Public Odata
Public sResult() As String


Sub SetupArray(ByVal rRange As Range)
Dim i As Long, j As Long, lCnt As Long


    Odata = rRange.Value2       'get the data to an array
    iRows = UBound(Odata, 1)
    iCols = UBound(Odata, 2)
    
    lCnt = 1                    'work out how many results to get
    For j = 1 To iCols
        For i = 1 To iRows
            If Odata(i, j) = "" Then
                i = i - 1
                Exit For
            End If
        Next i
        lCnt = lCnt * i
    Next j
    
    iSol = 1                    'make space for the results
    ReDim sResult(1 To lCnt, 1 To 2)
    
    Call Recursive("", 1)
    
    Sheets("Feuil3").Cells(10, 1).Resize(lCnt, 2).Value2 = sResult      'Need to set where the results go
    
End Sub


Sub Recursive(ByVal STemp As String, jCol As Long)
    For i = 1 To iRows
        If Odata(i, jCol) <> "" Then
            If jCol = iCols Then    'last column so this is a solution
                sResult(iSol, 1) = Trim(STemp & " " & Odata(i, jCol))
                iSol = iSol + 1
            Else                    'or keep going
                Call Recursive(STemp & " " & Odata(i, jCol), jCol + 1)
            End If
        End If
    Next i
End Sub


Sub test()
    Call SetupArray(Sheets("Feuil1").Range("A3:D7"))   'need to set the three tables and call sequentially updating the output range
End Sub
 
Last edited:
Never use merged cells in combination with VBA.
This suffices
Code: 
Sub tst()
    Feuil1.Cells.UnMerge
    M_snb_002 Feuil1.Cells(3, 1)
    M_snb_002 Feuil1.Cells(3, 6)
    M_snb_002 Feuil1.Cells(3, 11)
End Sub

Sub M_snb_002(c00)
    sn = c00.CurrentRegion
    
    For j = 1 To UBound(sn)
      If sn(j, 1) <> "" Then
        For jj = 1 To UBound(sn)
            If sn(jj, 2) <> "" Then
              For jjj = 1 To UBound(sn)
                 If sn(jjj, 3) <> "" Then
                    If UBound(sn, 2) = 3 Then
                          c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3)
                    Else
                        For jjjj = 1 To UBound(sn)
                          If sn(jjjj, 4) <> "" Then c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3) & "_" & sn(jjjj, 4)
                        Next
                    End If
                End If
              Next
            End If
        Next
      End If
    Next
    sp = Split(Mid(c01, 2), vbLf)
    
    Feuil2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
End Sub
 
WizzardOfOz and snb thank for your help.

I will test and analyse the macros. I'll come back to tell you if it's ok.
 
snb,
Nested for loop is fine for the stated question which has 3 or 4 columns but if this was just an abbreviated example to post it would require more nested for's. In contrast the recursive function is not bound by the number of columns.

I like the last 2 lines, neat!
 
Hi at all,

I studied snb's macro. It's a very good job!
I don't understand completly the code but i I proposed to you, an complementary adaptation for 2 columns. It's work fine for me.

Code: 
Sub tst()
    Feuil1.Cells.UnMerge
    M_snb_002 Feuil1.Cells(3, 1)
    M_snb_002 Feuil1.Cells(3, 6)
    M_snb_002 Feuil1.Cells(3, 11)
    M_snb_002 Feuil1.Cells(3, 15)
End Sub

Sub M_snb_002(c00)
    sn = c00.CurrentRegion
    
    For j = 1 To UBound(sn)
      If sn(j, 1) <> "" Then
        For jj = 1 To UBound(sn)
            If sn(jj, 2) <> "" Then
               If UBound(sn, 2) = 2 Then
                     c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2)
               Else
                   For jjj = 1 To UBound(sn)
                      If sn(jjj, 3) <> "" Then
                         If UBound(sn, 2) = 3 Then
                               c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3)
                         Else
                             For jjjj = 1 To UBound(sn)
                               If sn(jjjj, 4) <> "" Then c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3) & "_" & sn(jjjj, 4)
                             Next
                         End If
                      End If
                   Next
                End If
            End If
        Next
      End If
    Next
           
    sp = Split(Mid(c01, 2), vbLf)
    
    Feuil2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
End Sub
 
Last edited:
Snb i have a question :

Why you don't use merged cell in combination with VBA ?

Thank for your response.
 
You must log in or register to reply here.
Back
Top