SOLVED

vba for - delete rows with incomplete data in a worksheet

Bronze Contributor

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

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 Sub

 

Hope that it is bug-free.

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

 

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

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

 

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

 

'

 

best response confirmed by Lorenzo Kim (Bronze Contributor)
Solution

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

 

Mr. Chan

I tested your vba -- it worked perfectly!!

I wish I can program that way...

You are very kind and helpful.

MANY MANY THANKS

Mr. Chan

when I copied the following line and send it thru skype to one of my co-worker..

CS.Range("L2").Formula = "=counta(A2)*counta(B2)*counta(C2)*counta(D2)*counta(G2)*counta(H2)"

this is what it shows:

千刮湡敧∨㉌⤢䘮牯畭慬㴠∠挽畯瑮⡡㉁⨩潣湵慴䈨⤲挪畯瑮⡡㉃⨩潣湵慴䐨⤲挪畯瑮⡡㉇⨩潣湵慴䠨⤲"

what could this mean? is this a translation of the code? would this affect my VBA codes in my workbook?

many thanks

 

I cannot read the information you copied. 

 

I suspect the usage of "CS." in vba. I usually use "Set CS = Sheets("Sheet1")" at the beginning so that I need not to write Sheets("Sheet1") everytime. You may refer Sheet1 with the sheet name you used in your workbook. 

Mr Chan

Thank you for your reply.

I tried copying your code to ms word and notepad - both turns out ok.

only when I copy it to skype - some sort of chinese code was paste to it.

I wonder - could it be a chinese software? or maybe a fluke... hope it is not some sort of virus.....

anyway - as long as it is not affecting my program - then LET IT BE...

many many thanks

 

I am using Chinese Version of Excel and Windows. It may be a problem. I think you can type it again to avoid the problem.

Mr. Chan

Thank you for your assistance.

It is an honor to know you..

CS.Range("L2").Formula = "=counta(A2)*counta(B2)*counta(C2)*counta(D2)*counta(G2)*counta(H2)"

Mr Chan

Excel is considering an entry of space as not blank , in your above script, may I request that you put a check if it has a leading space - if so, make it a blank entry.

many thanks for your usual support

I think you can replace counta(A1) by len(trim(A1))

 

TRIM is a function to remove unnecessary spaces and then LEN to calculate the length of the cell. 

I think you can replace counta(A1) by len(trim(A1))

 

TRIM is a function to remove unnecessary spaces and then LEN to calculate the length of the cell. 

Mr. Chan

Thank you for your reply.

problem solved!

Your solutions are mostly very logical and precise, how I wish I could do that..

you have been very kind and helpful.

many many thanks

Mr. Chan

the following request for VBA is very similar to this article (the same project);

If it is not too much, May I request for your help again?

many many thanks

 

Requesting for help for VBA for the following scenario:

let us assume i is the number of rows from 2 to 1001 (checking range C2:G1001)

The criteria is this:

if Ci & Di are filled with data then Gi should be > 0 to have a complete row entry otherwise after an entry of zero or less, a MsgBox appears to prompt for correct entry.

if Ci & Di are filled, the cursor should automatically go to Gi .

To escape this check, either Ci or Di can be erased to clear the preset criteria.

following the above logic if Ci,Di,Gi are filled, Gi can never be erased unless Ci or Di is erased first.

 

Should this check be in:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) or
Private Sub Worksheet_Change(ByVal Target As Range)?



Kim, sorry for the late reply. I was kept busy with my work and then got sick for a few days recently. 

 

I have no idea about the situation you mentioned. I will check it later and try to provide a solution. 

1 best response

Accepted Solutions
best response confirmed by Lorenzo Kim (Bronze Contributor)
Solution

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

 

View solution in original post