Delete Row if Columns K:R all contain blanks VBA Excel

Question

Bit of a background: I'm trying to copy a table from "Create Form" N2:AE14

Set r = Sheets("Create Form").Range("COPYTABLEB")
Selection.Copy

Set dest = Sheets("Sample Data").Range("B1").End(xlDown).Offset(1, 0)     
r.Copy
dest.PasteSpecial Paste:=xlPasteValues

I want it to copy only the cells that have values and not blanks but unfortunately it's picking up the formulas and pasting them as blanks. So when I go to paste the next section in, it sees the blanks as data.

So instead I'm trying to figure out a way of deleting an entire Row in "Sample Data" if Columns K:R all contain blanks once its been copied across.

I currently have a loop that does it for column B being blank but it takes far too long.

Lastrow = Range("B" & Rows.Count).End(xlUp).Row
MsgBox (Lastrow)
For i = Lastrow To 2 Step -1
If Trim(Range("B" & i).Value) = "" And Trim(Range("B" & i).Value) = "" Then
Range("B" & i).EntireRow.Select
Selection.Delete

End If

Next i

Could someone please help me either:
a.) copy and paste the values across minus all the blanks
b.) or help me with a quicker way of deleting the rows?

you wrote _"deleting an entire Row in "Sample Data" if Columns K:R all contain blanks "_ but your code (`If Trim(Range("B" & i).Value) = "" And Trim(Range("B" & i).Value) = "" Then ` checks for column "B" empty cells: what's your real need? — user3598756, Mar 05 '17 at 17:46

score 0 · Accepted Answer · answered Mar 05 '17 at 18:09

0

assuming

you want to delete

"an entire Row in "Sample Data" if Columns K:R all contain blanks"

you could try this:

Sub CopyValuesAndDeleteRowsWithBlankKRColumns()
    Dim pasteArea As Range
    Dim iRow As Long

    With Sheets("Create Form").Range("COPYTABLEB")
        Set pasteArea = Sheets("Sample Data").Range("B" & Rows.count).End(xlUp).Offset(1, 0).Resize(.Rows.count, .Columns.count)
        pasteArea.Value = .Value
    End With
    With Intersect(pasteArea, Sheets("Sample Data").Range("K:R"))
        For iRow = .Rows.count To 1 Step -1
            MsgBox WorksheetFunction.CountBlank(.Rows(iRow)) & " - " & WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8
            If WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8 = 0 Then .Rows(iRow).EntireRow.Delete
        Next
    End With
End Sub

answered Mar 05 '17 at 18:09

user3598756

28,893
4
18
28

@Shawn Cartwright, if my answer solves your question then please accept it by clicking on the check mark beside the answer to toggle it from greyed out to filled in. thank you – user3598756 Mar 06 '17 at 14:50
@ShawnCartwright, any chance to get feedback from you? – user3598756 Mar 08 '17 at 22:18
Fantastic this works a treat. Only problem I have is I was sorted by descending order and then added a hyper link in the column next to it on the top row. Are you able to help? Public Sub Hyperlink() Dim Path As String 'Create the hyperlink on the Job Number Worksheets("Sample Data").Select Path = ThisWorkbook.Path & "\Sample PDFs\" & Range("B2") & " - " & Range("H2") & ".pdf" Worksheets("Sample Data").Hyperlinks.Add Anchor:=Range("C2"), Address:=Path, TextToDisplay:="File" End Sub – Shawn Cartwright Mar 10 '17 at 10:23
For iRow = .Rows.Count To 1 Step -1 If WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8 = 0 Then .Rows(iRow).EntireRow.Delete Could you please explain what this section of code is doing? – Shawn Cartwright Mar 13 '17 at 12:12
It appears to be removing the actual data as well now at the end. – Shawn Cartwright Mar 13 '17 at 12:14
Can anyone help please? It appears to be taking away the line with all the complete data?! – Shawn Cartwright Mar 14 '17 at 13:57

Delete Row if Columns K:R all contain blanks VBA Excel

1 Answers1