totn Excel

MS Excel 2003: Cleanup an export of raw data

This Excel tutorial explains how to write a macro to clean up an export of raw data in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: In Microsoft Excel 2003/XP/2000/97, I have an Excel spreadsheet that contains an export of some raw data. However, the data does not continue on the same row, it drops to the next one. How can I build a macro that will look at the first entry "Word" in column A, and move it to a certain cell in the previous row.

For example:

If cell A? says "TimberWeight" - nothing needs to be done.
If cell A? says "Contract Information", the rest of the row (ie: cells A through H) needs to be moved to the previous row, cell M.
If cell A? says "Location", the rest of the row (ie: cells A through T) needs to be moved to the previous row, cell T.

Then the blank rows need to be deleted.

Answer: Let's look at an example.

Download Excel spreadsheet (as demonstrated below)

Microsoft Excel

In this spreadsheet, we've created a macro called CleanupData. You can run the macro by selecting Macro > Macros under the Tools menu. Then highlighting the macro called CleanupData and clicking on the Run button.

Once the macro has run, the spreadsheet will look as follows:

Microsoft Excel

You can press Alt+F11 to view the VBA code.

Macro Code

The macro code looks like this:

Sub CleanupData()

   Dim LRow As Integer

   LRow = 1

   'Move through records until an empty cell is found in column A
   While IsEmpty(Range("A" & CStr(LRow)).Value) = False

      'If cell A? displays "Contract Information" then move the row to
      'cell M of the previous row and then delete the empty row
      If Range("A" & CStr(LRow)).Value = "Contract Information" Then
         'Move the row
         Range("A" & LRow & ":H" & LRow).Select
         Selection.Cut
         Range("M" & LRow - 1).Select
         ActiveSheet.Paste

         'Delete the empty row
         Rows(LRow & ":" & LRow).Select
         Selection.Delete Shift:=xlUp

         'Decrement counter since row was deleted
         LRow = LRow - 1

      'If cell A? displays "Location" then move the row to
      'cell T of the previous row and then delete the empty row
      ElseIf Range("A" & CStr(LRow)).Value = "Location" Then
         'Move the row
         Range("A" & LRow & ":T" & LRow).Select
         Selection.Cut
         Range("T" & LRow - 1).Select
         ActiveSheet.Paste

         'Delete the empty row
         Rows(LRow & ":" & LRow).Select
         Selection.Delete Shift:=xlUp

         'Decrement counter since row was deleted
         LRow = LRow - 1
      End If

      LRow = LRow + 1
   Wend

End Sub