Vba delete rows if cell in range is blank?

Question

I have a worksheet like so:

Column A   < - - - -         
A                   |
B                    - - - - Range A30:A39
C                   |
                    |
            < - - - - 
Next Line



Text way down here

I am using this code to delete the empty cells in my range A30:39. This range sits above the 'Next Line' value.

wStemplaTE.Range("A30:A39").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

In an ideal world, this code should cause this to happen:

Column A
A
B
C
Next Line


Text way down here

But instead it's causing the last bit of text to shift upwards like this:

Column A
A
B
C
Next Line
Text Way down here

Next Line and Text way down here are not even in this range.

Can someone show me what i am doing wrong?

My Entire code:

Sub Create()
'On Error GoTo Message
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    Dim WbMaster As Workbook
    Dim wbTemplate As Workbook
    Dim wStemplaTE As Worksheet
    Dim i As Long
    Dim LastRow As Long
    Dim rngToChk As Range
    Dim rngToFill As Range
    Dim rngToFill2 As Range
    Dim rngToFill3 As Range
    Dim rngToFill4 As Range
    Dim rngToFill5 As Range
    Dim rngToFill6 As Range
    Dim rngToFill7 As Range
    Dim rngToFill8 As Range
    Dim rngToFill9 As Range
    Dim rngToFil20 As Range
    Dim CompName As String
    Dim TreatedCompanies As String
    Dim FirstAddress As String
    '''Reference workbooks and worksheet
    Set WbMaster = ThisWorkbook

    '''Loop through Master Sheet to get company names
    With WbMaster.Sheets(2)
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        '''Run Loop on Master
        For i = 2 To LastRow
            '''Company name
            Set rngToChk = .Range("B" & i)
            CompName = rngToChk.value

            If InStr(1, TreatedCompanies, CompName) Or CompName = vbNullString Then
                '''Company already treated, not doing it again
            Else
                '''Open a new template
                Set wbTemplate = Workbooks.Open("G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\Templates\template.xlsx")
                Set wStemplaTE = wbTemplate.Sheets(1)

                '''Set Company Name to Template
                wStemplaTE.Range("C12").value = CompName
                wStemplaTE.Range("C13").value = rngToChk.Offset(, 1).value
                wStemplaTE.Range("C14").value = rngToChk.Offset(, 2).value
                wStemplaTE.Range("C15").value = rngToChk.Offset(, 3).value
                wStemplaTE.Range("C16").value = Application.UserName
                wStemplaTE.Range("C17").value = Now()
                wStemplaTE.Range("A20").value = "Announcement of Spot Buy Promotion - Week " & ThisWorkbook.Worksheets(1).Range("I8").value & " " & ThisWorkbook.Worksheets(1).Range("T8").value







                Dim strDate
                Dim strResult
                strDate = rngToChk.Offset(, 14).value
                wStemplaTE.Range("C25").value = "Week " & ThisWorkbook.Worksheets(1).Range("I8").value & " " & ThisWorkbook.Worksheets(1).Range("T8").value & " " & WeekdayName(Weekday(strDate)) & " (" & strDate & ")"

                'Set Delivery Date
                wStemplaTE.Range("C26").value = WeekdayName(Weekday(rngToChk.Offset(, 15).value)) & " (" & rngToChk.Offset(, 15).value & ")"






                '''Add it to to the list of treated companies
                TreatedCompanies = TreatedCompanies & "/" & CompName
                '''Define the 1st cell to fill on the template
                Set rngToFill = wStemplaTE.Range("A30")
                Set rngToFill2 = wStemplaTE.Range("B30")
                Set rngToFill3 = wStemplaTE.Range("C30")
                Set rngToFill4 = wStemplaTE.Range("D30")
                Set rngToFill5 = wStemplaTE.Range("E30")
                Set rngToFill6 = wStemplaTE.Range("F30")
                Set rngToFill7 = wStemplaTE.Range("G30")

                Set rngToFill8 = wStemplaTE.Range("C13")
                Set rngToFill9 = wStemplaTE.Range("C14")
                Set rngToFil20 = wStemplaTE.Range("C15")




                With .Columns(2)
                    '''Define properly the Find method to find all
                    Set rngToChk = .Find(What:=CompName, _
                                After:=rngToChk.Offset(-1, 0), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False, _
                                SearchFormat:=False)

                    '''If there is a result, keep looking with FindNext method
                    If Not rngToChk Is Nothing Then
                        FirstAddress = rngToChk.Address
                        Do
                            '''Transfer the cell value to the template
                            rngToFill.value = rngToChk.Offset(, 7).value
                            rngToFill2.value = rngToChk.Offset(, 8).value
                            rngToFill3.value = rngToChk.Offset(, 9).value
                            rngToFill4.value = rngToChk.Offset(, 10).value
                            rngToFill5.value = rngToChk.Offset(, 11).value
                            rngToFill6.value = rngToChk.Offset(, 12).value
                            rngToFill7.value = rngToChk.Offset(, 13).value



                            '''Go to next row on the template for next Transfer
                            Set rngToFill = rngToFill.Offset(1, 0)
                            Set rngToFill2 = rngToFill.Offset(0, 1)
                            Set rngToFill3 = rngToFill.Offset(0, 2)
                            Set rngToFill4 = rngToFill.Offset(0, 3)
                            Set rngToFill5 = rngToFill.Offset(0, 4)
                            Set rngToFill6 = rngToFill.Offset(0, 5)
                            Set rngToFill7 = rngToFill.Offset(0, 6)



                            '''Look until you find again the first result
                            Set rngToChk = .FindNext(rngToChk)
                        Loop While Not rngToChk Is Nothing And rngToChk.Address <> FirstAddress
                    Else
                    End If
                End With '.Columns(2)






                Set Rng = Range("D30:G39")
                Rng.Select
                Set cell = Selection.Find(What:="#VALUE!", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

                If cell Is Nothing Then
                'do it something
                Else
                For Each cell In Rng
                cell.value = "TBC"
                Next
'End For
wStemplaTE.Range("A41").value = "Please fill in the pallet factor and case size accordingly. Please amend total volume if necessary to accommodate full pallets."
End If


                Rng.Select
                Set cell = Selection.Find(What:="TBC", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

                If cell Is Nothing Then
                'do it something
                Else

wStemplaTE.Range("A41").value = "Please fill in the pallet factor and case size accordingly. Please amend total volume if necessary to accommodate full pallets."
End If

'Remove uneeded announcement rows
wStemplaTE.Range("A30:A39").SpecialCells(xlCellTypeBlanks).EntireRow.Delete









                file = AlphaNumericOnly(CompName)
                wbTemplate.SaveCopyAs filename:="G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\test\" & file & ".xlsx"
                wbTemplate.Close False
            End If
        Next i
    End With 'wbMaster.Sheets(2)
    Application.DisplayAlerts = True
Application.ScreenUpdating = True


Dim answer As Integer
answer = MsgBox("Announcements Successfully Created." & vbNewLine & vbNewLine & "Would you like to view these now?", vbYesNo + vbQuestion, "Notice")
If answer = vbYes Then
Call List
Else
    'do nothing
End If

Exit Sub

Message:
wbTemplate.Close savechanges:=False
MsgBox "One or more files are in use. Please make sure all Announcement files are closed and try again."
Exit Sub

End Sub



Function AlphaNumericOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    AlphaNumericOnly = strResult
End Function




Function FindAll(SearchRange As Range, _
                FindWhat As Variant, _
                Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range

                End Function

I not too familliar with that method for deleting but it must be when it deletes some rows the rows below then become part of that range. — Gordon
wStemplaTE.Range("A30:A39").SpecialCells(xlCellTypeBlanks).EntireRow.Delete this code is okay. May you doing mistake elsewhere. — Harun24HR
@harun24hr please see full code, i can't see where i might be going wrong — user7415328

Ibo Ibo · Accepted Answer · 2017-03-03T22:12:20

Modify the column as you need. Right now it is working on column A. You can make it an argument to ask the user, like the second code

Public Sub DeleteRowOnCell()
'====================================================================================
'This macro will delete the entire row if a cell in the specified column is blank.
'Only one specified column is checked. Other columns are ignored.
'====================================================================================
    On Error Resume Next
    Range("A3:A" & Rows.count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End Sub

Public Sub DeleteRowOnCellAsk()
'====================================================================================
'This macro will delete the entire row if a cell in the specified column is blank.
'Only one specified column is checked. Other columns are ignored.
'====================================================================================
    Dim inp As String
    inp = InputBox("Please enter a column name based on which blank rows will be deleted", "Which Column?")
    Debug.Print inp & ":" & inp & Rows.count
    On Error Resume Next
        Range(inp & "1" & ":" & inp & Rows.count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Vba delete rows if cell in range is blank?

1 Answers