I’ve been given an excel spread sheet full of data to be loaded into a new table, however rather than being send as a multi column table the data was split into multiple key value pairs.

A simple bit of copy and pasting got it all into a multi column table, but left thousands of duplicate rows. The simplest way to fix it was a quick bit of VBA to merge the rows and remove the duplicates, before importing it into SQL. Example Code below:

Sub MergeRows()
Dim r As Long
Dim p As Long
Dim duplicates As Long
Dim keyCell As Variant
Dim rng As Range
Dim col_key As Long
Dim col_title As Long
Dim col_author As Long
Dim col_publisher As Long
Dim col_price As Long
' set columns
col_key = 1
col_title = 2
col_author = 3
col_publisher = 4
col_price = 5
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Select Cell A1 and set range to table
Cells(1, 1).Select
Set rng = Application.Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(ActiveCell.Column))
Application.StatusBar = "Processing Row: " + Format(rng.Row, "#,##0")
' initialise duplicate count
duplicates = 0
' step from end of range to the start
For r = rng.Rows.Count To 2 Step -1
If r Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " + Format(r, "#,##0")
End If
' get key value from current row
keyCell = rng.Cells(r, col_key)
' set previous row
p = r - 1
' check if key value = key value on previous row
If rng.Cells(p, col_key) = keyCell Then
' keys match
duplicates = duplicates + 1
' check each column and merge cell to previous row if previous row/cell is blank
If (IsEmpty(rng.Cells(p, col_title)) And Not IsEmpty(rng.Cells(r, col_title))) Then
rng.Cells(p, col_title) = rng.Cells(r, col_title)
End If
If (IsEmpty(rng.Cells(p, col_author)) And Not IsEmpty(rng.Cells(r, col_author))) Then
rng.Cells(p, col_author) = rng.Cells(r, col_author)
End If
If (IsEmpty(rng.Cells(p, col_publisher)) And Not IsEmpty(rng.Cells(r, col_publisher))) Then
rng.Cells(p, col_publisher) = rng.Cells(r, col_publisher)
End If
If (IsEmpty(rng.Cells(p, col_price)) And Not IsEmpty(rng.Cells(r, col_price))) Then
rng.Cells(p, col_price) = rng.Cells(r, col_price)
End If
'delete current row
rng.Rows(r).EntireRow.Delete
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "Duplicates merged: " + Format(duplicates, "#,##0")
End Sub