Forum Discussion
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 rows with incomplete data (in range say, column A to J only ) and should not delete the entire row because in the further columns there are drop down lists and other data. This is sort of a clean-up and should be in a SUB to be called/ invoked only if required (not automatic).
The idea is to clear the range contents (column A to J only) with incomplete data then to move up the complete row of data to the empty ones (no sorting required-just in their original sequence). The worksheet has a data range from A2 down to J1001.
There may be several rows of incomplete data.. whew
many thanks
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
36 Replies
I think you have to do clearcontent when the row is incomplete. After that, copy all other information one row upward.
Sub Delete_Incomplete_Row()
ActiveSheet.range("A1002") = "END OF ROW"
For i = 1 to 1001
If ActiveSheet.Range("A" & i) = "END OF ROW" then exit for
' I am afraid the for-loop with not end so include "END OF ROW" to
' exit the for-loop
check = Checking_of_Incomplete_Row
' return a true value when the row is incomplete
If check then
ActiveSheet.Range("A" & i & ":J" &i).clearcontents
ActiveSheet.Range("A" & i+1 & ":J1001").copy destination:=ActiveSheet.range("A" & i)
i = i-1
End If
Next i
End SubHope that it is bug-free.
check = Checking_of_Incomplete_Row
' return a true value when the row is incompleteIn the above routine - how is the vba for the ff:
if Columns ABCDGH are empty , check is true (the row is incomplete)
many many thanks
I am not sure if your excel allows to include one more column contains:
=counta(A2:D2)+counta(G2:H2)
If the value is 0, it means that ABCDGH are all empty and hence check can be determined.
If the incomplete row is determined by one of the cells empty, you may consider
= counta(A2)*counta(B2)*counta(C2)*counta(D2)*counta(G2)*counta(H2)
Since zero multiply any number will be zero, so the value will be 0 if one of the cell is empty.
Mr Chan
Thank you for your reply.
I will try it and give you feedback.
meanwhile, Can I bother you for one more task?
instead of deleting the range - just simply Hi-light the row range with say light red foreground color..
MANY MANY THANKS
To highlight the row range, you may consider the code below:
ActiveSheet.Range("A" & i & ":J" & i).Interior.Color = RGB (x,y,z)You have to search the color code on the internet.
http://www.wahart.com.hk/rgb.htm
