Forum Discussion

Lorenzo Kim's avatar
Lorenzo Kim
Bronze Contributor
Jun 01, 2018
Solved

vba for - delete rows with incomplete data in a worksheet

I have searched the net - but couldn't find a right solution. I have a workbook of data - there are columns that data entry is a must (say, columns A,B,C,D ,G,H,J ) and I would like to delete the ro...
  • Man Fai Chan's avatar
    Man Fai Chan
    Jun 02, 2018

    I prepared an example but xlsm/xlsb are not allowed for the attachment. 

     

    You may download the file and include the following code by yourself for testing. 

    Sub Delete_Highlight_Incompleted_Row()
    ' To delete or highlight incompleted row

    Set CS = ActiveSheet
    ' I prefer to use short name for sheet

    x = Val(InputBox("Input the last row of data"))
    CS.Range("A" & x + 1) = "END OF ROW"
    ' introduce the last row checker to exit for-loop
    'avoid looping infinitely

    y = Val(InputBox("What do you want to do?" & Chr(10) & _
    "1: Delete the incompleted row" & Chr(10) & _
    "2: Highlight the incompleted row"))
    If y <> 1 Then y = 2 ' avoid other input for x2

    CS.Range("L2").Formula = "=counta(A2)*counta(B2)*counta(C2)*counta(D2)*counta(G2)*counta(H2)"
    ' you may include *counta(J2) if you need to check the column J as well
    ' I assume that column L is free

    For r = 2 To x
    If CS.Range("A" & r) = "END OF ROW" Then
    ' CS.Range("A" & r).ClearContents
    ' Clear the "END OF ROW"
    ' You may convert it into program in your usage
    Exit For
    End If

    CS.Range("L2").Copy Destination:=CS.Range("L" & r)

    If CS.Range("L" & r) = 0 Then
    ' Row r is an incompleted row
    Select Case y
    Case 1 ' to delete the incompleted rows
    CS.Range("A" & r & ":J" & r).ClearContents
    CS.Range("A" & r + 1 & ":J" & x + 2).Copy Destination:=CS.Range("A" & r)

    r = r - 1
    ' since the row is moved upward, I need to reduce the value of r
    ' otherwise, I cannot delete two consecutive incompleted row

    Case 2 ' to highlight the incompleted rows
    CS.Range("A" & r & ":J" & r).Interior.Color = RGB(255, 0, 0)
    ' highlight with red
    ' you may change rgb code on your preference
    'no need to r = r - 1 as the row is not moved upward

    End Select

    End If
    Next r

    ' CS.Range("L:L").ClearContents
    ' To delete the dummy column for checking empty row
    ' I make it a comment here so that you can see the effect on the column L

    ' If y = 2 Then
    ' CS.Range("A" & x + 1).ClearContents
    ' End If
    ' Clear the "END OF ROW"
    ' You may include this in your usage


    End Sub

     

Resources