If Cell Blank Copy Data from Above Combine All to Current

ChrisOK · #1 12-18-2017, 06:44 PM

The attached system generated file has a lot of garbage rows I'm trying to clear out using code. I need to have vba scan down COL A for a blank cell.

IF BLANK, look to the first filled COL D cell ABOVE IT and copy it's contents into COL A's blank cell.
Example: D3 would get copy/pasted down to A4 next to the invoice content line.

(the only rows of content I want to keep are the ones where Invoice#s are present-- BUT I need to bring the CUST NAME down and populate it into Col A before I delete the garbage rows like rows: 3, 7, 12, 20, etc.)

The next thing I need to do is delete all the blank rows like rows: 2, 5, 6, 10, 11 etc.)
The final thing is to COMBINE all the invoice amounts floating in COLS H,I, J, K

When all is done, it should look like the sample RESULT tab shown within the file.

NoSparks · #2 12-18-2017, 10:11 PM

Make a copy of Sheet1, by default it will be Sheet1 (2)
give this a try on the copy

Code:

Sub ChrisOK_macro()
' https://www.msofficeforums.com/excel-programming/37657
' Dec 18, 2017

    Dim lr As Long
    Dim rng As Range, cl As Range
    Dim Cust As String, x As Integer
    
 Application.ScreenUpdating = False
 
 With Sheets("Sheet1 (2)")
    
    'establish a range of Cust# in column A
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For Each cl In .Range("A2:A" & lr)
        If Not IsEmpty(cl.Offset(, 3)) Then
            If rng Is Nothing Then
                Set rng = cl
            Else
                Set rng = Union(rng, cl)
            End If
        End If
    Next cl
    
    'get the cust name and copy it
    For Each cl In rng
        x = 1
        Cust = cl.Offset(, 3)
        Do Until IsEmpty(cl.Offset(x, 1))
            cl.Offset(x) = Cust
            x = x + 1
        Loop
    Next cl
    
    'delete all rows where col C is blank
    Range("C1:C" & lr).SpecialCells(xlBlanks).EntireRow.Delete
    
    'combine H I J K
    lr = .Cells(Rows.Count, "A").End(xlUp).Row  'new last row
    For Each cl In Range("G2:G" & lr)
        If IsEmpty(cl) Then
            cl.FormulaR1C1 = "=SUM(RC[1]:RC[4])"
            cl.Value = cl.Value
        End If
    Next cl
    
    'clear cols H I J K
    .Range("H2:K" & lr).ClearContents
    
End With

Application.ScreenUpdating = True

End Sub

ChrisOK · #3 12-18-2017, 11:25 PM

It works! That's so awesome!! Love it!
I was piecing together recordings and got stuck --so your solution is perfect to overcome the roadblock! Thanks greatly! I'll click to add to your "Reputation" area!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
filling in blank cells with data from cell above	RayK	Excel	1	01-12-2017 04:14 PM
copy a cell from 1 file to another when data changes	jpreeshl	Excel	5	01-20-2016 09:06 AM
a macro that can copy data from copy.xls to our current excel macro.xls based on criteria:	udhaya	Excel Programming	1	11-12-2015 10:12 AM
Data Validation - Prevent blank cell based on a condition	dawd	Excel	2	08-12-2015 05:44 AM
How to combine different cells data in one cell?	Learner7	Excel	1	07-28-2010 12:07 PM