A button to transpose data into a destination table

Question

Hi, I have a table filled with data that I need to be pasted into a final blank table but the destination table is larger than the original table. Also the data needs to be sorted by one column and the column order doesn't match. See image.

This is a process that needs to be carried out by people with limited experience of excel or even computers, hence thinking that a button linked to a macro might be a solution, but open to any solutions!

Thanks

oliverscheurich · Answer

An alternative could be Power Query. In the attached file you can add data to the blue dynamic table. Then you can click in any cell of the green table and right-click with the mouse and select refresh to update the green result table.

The data layout in the screenshot and in the attached file is for illustration. You can place the green result table in another worksheet as well.

sergeibaklan · Answer

In general that could be formula if locations of Source and Destination are predefined=LET(
   source,  TRIMRANGE($A$4:$C$10000),
   IDs,     SORT( TRIMRANGE($E$4:$E$10000) ),
   headers, CHOOSECOLS($A$3:$C$3, {1,3,2} ),
   VSTACK(
       headers,
       HSTACK(
          IDs,
          XLOOKUP(IDs, CHOOSECOLS(source,1), CHOOSECOLS(source,3), ""),
          XLOOKUP(IDs, CHOOSECOLS(source,1), CHOOSECOLS(source,2), "")
      )
  )
)

chjenssxu · Answer

Sub TransformTable()
    Dim dataRng As Range
    Dim arr
    Dim includeHearder As Boolean
    Dim startRow As Integer
    Dim i As Long
    Dim d As Object
    Dim k, v1, v2
    Dim maxId As Long
    Dim minId As Long
    Dim brr
    Dim resultRng As Range
    
    On Error Resume Next
    Set dataRng = Application.InputBox("Select data area!", Default:=ActiveCell.Address, Type:=8)
    Err.Clear
    On Error GoTo 0
    
    If dataRng Is Nothing Then
        MsgBox "You didn't select any data area, process exit!"
        Exit Sub
    End If
    
    arr = dataRng.Value
    
    startRow = LBound(arr, 1)
    includeHearder = MsgBox("Is the first row header?", vbYesNo) = vbYes
    If includeHearder Then
        startRow = startRow + 1
    End If
    
    maxId = 10
    minId = 1
    Set d = CreateObject("Scripting.Dictionary")
    d.RemoveAll
    
    For i = startRow To UBound(arr, 1)
        d.Add CStr(Trim(arr(i, 1))), Array(arr(i, 2), arr(i, 3))
        If maxId &lt; arr(i, 1) Then
            maxId = arr(i, 1)
        End If
        If minId &gt; arr(i, 1) Then
            minId = arr(i, 1)
        End If
    Next i
    
    If includeHearder Then
        ReDim brr(minId To maxId + 1, 1 To 3)
        
        brr(minId, 1) = arr(LBound(arr, 1), 1)
        brr(minId, 2) = arr(LBound(arr, 1), 3)
        brr(minId, 3) = arr(LBound(arr, 1), 2)
        
        For i = minId To maxId
            k = CStr(i)
            brr(i + 1, 1) = i
            
            If d.Exists(k) Then
                brr(i + 1, 3) = d(k)(0)
                brr(i + 1, 2) = d(k)(1)
            End If
        Next i
    Else
        ReDim brr(minId To maxId, 1 To 3)
        For i = minId To maxId
            k = CStr(i)
            brr(i, 1) = i
            
            If d.Exists(k) Then
                brr(i, 3) = d(k)(0)
                brr(i, 2) = d(k)(1)
            End If
        Next i
    End If
    
    On Error Resume Next
    Set resultRng = Application.InputBox("Select the result cell!", Default:=dataRng.Cells(1).Offset(0, dataRng.Columns.Count + 1).Address, Type:=8)
    Err.Clear
    On Error GoTo 0
    
    If resultRng Is Nothing Then
        MsgBox "You didn't select result area, process exit!"
        Exit Sub
    End If
    
    With resultRng.Cells(1).Resize(UBound(brr, 1) - LBound(brr, 1) + 1, 3)
        .Borders.LineStyle = XlLineStyle.xlContinuous
        .Value = brr
    End With
    
    MsgBox "Done!"
End Sub&nbsp;

chrishall166 · Answer

chjenssxu, that is brilliant, love the way you've done that!

It's so good that I can see some ways to make it more robust for the people who will be using it, would you be able to look at my suggestions and make some mods?

The input table could have up to 100 entries in it, would it be possible to hard code the range to say A4:C103? Selecting just the data and not the headers also means that the user won't be confused when headers are mentioned.
The final table will actually be in another file, where it has 250 data rows. As well as creating it on the current sheet, which will be useful for validation is it also possible to put the output into the clipboard so the user can just do a ctrl-v in the output file?

Thanks!

chrishall166 · Answer

Thank you SergeiBaklan, I'm just going to give this a try!

Forum Discussion

A button to transpose data into a destination table

6 Replies

Resources