Forum Discussion
vba for - delete rows with incomplete data in a worksheet
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
check = Checking_of_Incomplete_Row
' return a true value when the row is incomplete
In 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.
Would you be kind enough to complete the sub codes for both delete and hi-lite?
(kindly refer to my original thread for better understanding)
I'm sorry, I am not well versed with vba programming codes.
MANY 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 SubMr. Man Fai Chan
How are you? I wish you are well and good.
sorry to bother you again..
I have made a code to delete duplicates.. it deletes the entire row. what if I just wanted to clearcontent in the row column A only (not the entire row); then copy to the blank cell the next data and check again if it is the same - then repeat the process until there is no duplicate.
How do I re-structure the code below?
many many thanks
Sub DeleteDuplicate()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
mdata = Cells(i - 1, "A")
If Cells(i, "A") = mdata Then Rows(i).Delete
Next iEnd Sub