Sep 07 2021 06:32 AM - edited Sep 07 2021 07:15 AM
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
Sep 07 2021 07:17 AM
SolutionHere 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
Sep 07 2021 07:20 AM - edited Sep 07 2021 07:24 AM
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"
Sep 07 2021 07:24 AM
Sep 07 2021 07:17 AM
SolutionHere 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