SOLVED

How can I merge 6 columns??

Copper Contributor

I'm normalising data to third normal form and I want to merge six columns of data into one (SkillsIDFK) column but the merged data has to be on the next line with the StaffIDFK repeated for each skill. 

The code below only works for 3 columns.

 

Sub MergePhone()
    Dim rng As Range
    Application.ScreenUpdating = False
    Set rng = Range("C:C").Find(What:="*", SearchDirection:=xlPrevious)
    Do
        rng.Offset(1).EntireRow.Insert
        rng.Offset(1, -2).Value = rng.Offset(0, -2).Value
        rng.Offset(1, -1).Value = "'" & rng.Value
        Set rng = Range("C:C").Find(What:="*", After:=rng, SearchDirection:=xlPrevious)
        If rng.Row = 1 Then Exit Do
    Loop
    Range("C:C").ClearContents
    Application.ScreenUpdating = True
End Sub

 

 

4 Replies
best response confirmed by Deerg65 (Copper Contributor)
Solution

@Deerg65 

Here is new code. It is slow, because it has to do a lot of checking.

The code can easily be modified if you need to merge more than 6 columns.

Sub MergeColumns()
    Dim r As Long
    Dim m As Long
    Dim c As Long
    Application.ScreenUpdating = False
    m = Cells(Rows.Count, 1).End(xlUp).Row
    For r = m To 2 Step -1
        For c = 7 To 3 Step -1
            If Cells(r, c).Value <> "" Then
                Cells(r + 1, 1).Resize(1, 7).Insert Shift:=xlShiftDown
                Cells(r + 1, 1).Value = Cells(r, 1).Value
                Cells(r + 1, 2).Value = Cells(r, c).Value
            End If
        Next c
        If Cells(r, 2).Value = "" Then
            Cells(r, 1).Resize(1, 7).Delete Shift:=xlShiftUp
        End If
    Next r
    Range("C:G").ClearContents
    Application.ScreenUpdating = True
End Sub

@Deerg65 

 

You can do it by using Power Query unpivoting the other columns.

 

 

let
  Source = Excel.CurrentWorkbook(){[Name = "Table1"]}[Content], 
  #"Changed Type" = Table.TransformColumnTypes(
    Source, 
    {
      {"StaffID FK", Int64.Type}, 
      {"Col1", Int64.Type}, 
      {"Col2", Int64.Type}, 
      {"Col3", Int64.Type}, 
      {"Col4", Int64.Type}, 
      {"Col5", Int64.Type}, 
      {"Col6", Int64.Type}
    }
  ), 
  #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(
    #"Changed Type", 
    {"StaffID FK"}, 
    "Attribute", 
    "Value"
  ), 
  #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns", {"Attribute"})
in
  #"Removed Columns"

 

 

Thanks:beaming_face_with_smiling_eyes::beaming_face_with_smiling_eyes:
Thanks:beaming_face_with_smiling_eyes:
1 best response

Accepted Solutions
best response confirmed by Deerg65 (Copper Contributor)
Solution

@Deerg65 

Here is new code. It is slow, because it has to do a lot of checking.

The code can easily be modified if you need to merge more than 6 columns.

Sub MergeColumns()
    Dim r As Long
    Dim m As Long
    Dim c As Long
    Application.ScreenUpdating = False
    m = Cells(Rows.Count, 1).End(xlUp).Row
    For r = m To 2 Step -1
        For c = 7 To 3 Step -1
            If Cells(r, c).Value <> "" Then
                Cells(r + 1, 1).Resize(1, 7).Insert Shift:=xlShiftDown
                Cells(r + 1, 1).Value = Cells(r, 1).Value
                Cells(r + 1, 2).Value = Cells(r, c).Value
            End If
        Next c
        If Cells(r, 2).Value = "" Then
            Cells(r, 1).Resize(1, 7).Delete Shift:=xlShiftUp
        End If
    Next r
    Range("C:G").ClearContents
    Application.ScreenUpdating = True
End Sub

View solution in original post