Excel VBA merging rows

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
Advertisements

About John

Software developer, lately specialising in Full Stack Web Development using c#, ASP.Net WebAPI 2, and Angular.
This entry was posted in Development and tagged , , . Bookmark the permalink.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s