Forum Discussion
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...
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
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 Sub
Mr. 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
addendum:
the column is sorted
Dear Kim,
It works fine with deleting rows. But if you want to clearcontent and move upward of the data, I prepared the following code:
Sub Delete_and_MoveUp()
n = Cells(Rows.Count, "A").End(xlUp).Row
For i = n To 2 Step -1
If Cells(i - 1, "A") = Cells(i, "A") Then
Cells(i, "A").ClearContents
Range("A" & i + 1 & ":A" & n).Cut Destination:=Cells(i, 1)
End If
Next i
End subBut I am not sure if the data in other column will change or not. Also, it may affect formula when using cut and paste.
Cheers,
Chan M F
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.
Mr. Chan
so sorry to hear that..
Hope you are now OK.
Thank 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.
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
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
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
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