excelvbamacosexcel-2011

Selectively merge Excel rows and delete original rows


I have a Microsoft Excel spreadsheet (Mac 2011).

  1. Some rows have data in columns A, C, D, E, F, and G. I will call these rows PARENT rows.

  2. Other rows have data only in column B. I will call them CHILD rows. Each CHILD row is actually a subset of the PARENT row above it.

  3. Each PARENT row has anywhere between 1 to 20 CHILD rows below it.

  4. The pattern usually is: PARENT ROW, several CHILD ROWS below it, then another PARENT ROW, several CHILD ROWS below it, then another PARENT ROW, etc.

I am trying to:

[a] Copy the contents of each PARENT row and add them to the CHILD rows below it.

[b] Once copied, delete the original PARENT row.

There are more than 40,000 rows in the spreadsheet, and I don't know how to create a macro.


Solution

  • You don't actually need a macro (but I have provided one at bottom)

    [Pls note this is a working solution for Excel on Windows - I have no experience with Excel for Macs so cannot guarantee that either or both the solutions below will work for you]

    Manual Solution

    1. Select Columns A, C, D and E (esnure you select column A first)
    2. Press F5 .... Goto Special and select Blanks and then hit "ok"
    3. In the formula bar, type =A1 where A1 is the cell immediately above the first blank cell from step 2 (see picture below, this cell is A1)
    4. Press the Ctrl and Enter keys together. You now have the correct data in the child rows
    5. Select columns A:E and Copy then Paste Special as Values to convert the formulae you just entered in the child rows to values
    6. Select Column B
    7. Press F5 .... Goto Special and select Blanks and then hit "ok" (see pic below)
    8. Delete the seleted rows

    Step 3 Step 7

    Code Solution

    Sub Delete()
    Dim rng1 As Range
    Dim rng2 As Range
    On Error Resume Next
    Set rng1 = Range("A:A,C:E").SpecialCells(xlBlanks)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub
    rng1.Formula = "=R[-1]C"
    'handles two row areas else SpecialCells will force both areas to area1 formulae
    For Each rng2 In rng1.Areas
    rng2.Value = rng2.Value
    Next rng2
    On Error Resume Next
    Set rng1 = Range("B:B").SpecialCells(xlBlanks)
    On Error GoTo 0
    If Not rng1 Is Nothing Then rng1.EntireRow.Delete
    End Sub