Forum Discussion

Deerg65's avatar
Deerg65
Copper Contributor
Sep 07, 2021
Solved

How can I merge 6 columns??

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

 

 

BI & Data Analysis
excel
Formulas and Functions
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Sep 07, 2021

    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

4 Replies

  • Juliano-Petrukio's avatar
    Juliano-Petrukio
    Bronze Contributor
    Sep 07, 2021

    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"

     

     

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Sep 07, 2021

    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

Resources