May 31 2018 07:55 PM
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
Jun 01 2018 07:18 AM
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.
Jun 01 2018 09:00 AM
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
Jun 01 2018 09:27 AM
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
Jun 01 2018 05:08 PM
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
Jun 01 2018 05:20 PM
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.
Jun 01 2018 05:34 PM
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
'
Jun 01 2018 06:10 PM - edited Jun 01 2018 06:15 PM
SolutionI 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
Jun 01 2018 07:48 PM
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
Jun 03 2018 10:36 PM
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
Jun 04 2018 05:56 AM
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.
Jun 04 2018 08:02 AM
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
Jun 04 2018 02:43 PM
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.
Jun 04 2018 03:56 PM
Mr. Chan
Thank you for your assistance.
It is an honor to know you..
Jun 13 2018 12:22 AM
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
Jun 14 2018 03:07 PM
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.
Jun 14 2018 03:08 PM
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.
Jun 14 2018 07:05 PM
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
Jun 17 2018 09:53 PM
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)?
Jun 23 2018 04:37 AM
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.
Jun 01 2018 06:10 PM - edited Jun 01 2018 06:15 PM
SolutionI 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