Question

Program: Excel 2010
Experience Basic

Issue:
I have a large table of data with some "split cells" (first/last name & currency), this is how it is from the original data (copied & pasted from a webpage, the data is split in 2). I need to make a clean table with all data on 1 row, not 2. I have some sample data below, and then further down I have included how I want it to look like.

The original formatting is a HTML table, pulled from a database (which I do NOT have access to, however I can generate a CSV but that in itself is another question due to how it is setup.)

Assume: Data in (A1); there are more than the listed values & columns, and I will accept either formula OR VBA answers and lastly: Ignore the blank rows, they were inserted to show the difference between tables more clearly.

Original Data:

| Date       | Transaction ID | Order Reference | Sender | Sender Email | Status | Payment Amount | Amount Paid |
|------------|----------------|-----------------|--------|--------------|--------|----------------|-------------|
| 17/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |
|            |                |                 |        |              |        |                |             |
| 13/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |
|            |                |                 |        |              |        |                |             |
| 13/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |
|            |                |                 |        |              |        |                |             |
| 12/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |  

Required Data: (notice the first/last are now on the same row as is the currency)

| Date       | Transaction ID | Order Reference | Sender |      | Sender Email | Status | Payment Amount |     | Amount Paid |     |
|------------|----------------|-----------------|--------|------|--------------|--------|----------------|-----|-------------|-----|
| 17/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |
|            |                |                 |        |      |              |        |                |     |             |     |
| 13/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |
|            |                |                 |        |      |              |        |                |     |             |     |
| 13/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |
|            |                |                 |        |      |              |        |                |     |             |     |
| 12/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |  

Thank you, have a great weekend.

[EDIT] Note, none of these cells are merged, each cell is an individual, and the "last" & "AUD" need to be moved right & up.

Was it helpful?

Solution

This should work for you:

Public Sub ModData()
    Dim colDate As Long
    Dim colTrans As Long
    Dim colOrder As Long
    Dim colSender As Long
    Dim colSenderEmail As Long
    Dim colStatus As Long
    Dim colPmtAmt As Long
    Dim colPaid As Long
    Dim r As Long
    Dim ws As Worksheet

    colDate = 1
    colTrans = 2
    colOrder = 3
    colSender = 4
    ' col 5 reserved for inserted col
    colSenderEmail = 6
    colStatus = 7
    colPmtAmt = 8
    ' col 9 reserved for inserted col
    colPaid = 10

    Set ws = ActiveSheet

    Application.ScreenUpdating = False

    ' Add extra columns needed.
    ws.Columns(colSender + 1).Insert Shift:=xlToRight
    ws.Columns(colPmtAmt + 1).Insert Shift:=xlToRight

    ' Move data to same row.
    For r = 2 To 12 Step 2
        ws.Cells(r, colSender + 1).Value = ws.Cells(r + 1, colSender).Value
        ws.Cells(r, colPmtAmt + 1).Value = ws.Cells(r + 1, colPmtAmt).Value
        ws.Cells(r, colPaid + 1).Value = ws.Cells(r + 1, colPaid).Value
    Next r

    ' Delete unnecessary rows.
    r = 3
    While ws.Cells(r - 1, 1).Value <> ""
        ws.Cells(r, 1).EntireRow.Delete
        r = r + 1
    Wend

    Application.ScreenUpdating = True
End Sub
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top