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 23 2018 04:26 PM
Mr. Chan
so sorry to hear that..
Hope you are now OK.
Thank you
Jun 23 2018 04:35 PM
Mr. Chan
To make it simpler, discard the Ci..
The scenario or event that should be capture is now this:
The range for checking is D2:G1001
if ever Di is entered with data, the cursor should go to Gi (in the same row) and awaits for an entry of number greater than zero otherwise a prompt appears for correct entry.
To bypass this check, Di have to be erased.
likewise, if Di & Gi are both filled, Gi can never be erased unless Di is erased first.
this should work this way, not the other way around.
the criteria is now: Gi should be filled whenever Di is inputed with data..
I hope this is much easier.
many many many thanks
Jun 23 2018 05:49 PM
Mr. Chan
Mr. Rick Rothstein provided me with the codes below (to my previous project) to prevent input to a cell if the cell immediately above it (the same column)is empty AND prevent delete of a cell if the cell immediately below it is non-blank. It is a short but very effective sub. I hope this can help you in making the vba I needed. Also I provided a snapshot of my recent worksheet for you to have a clearer view of my project.
i.e. If ever ITEM is inputted, the QTY must be also inputted (not vice versa)..
many many many thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
On Error GoTo OutOfRange
If Target.Row = 2 And Target.Offset(1) = "" Then Exit Sub
For Each Cell In Intersect(Target, Range("A:D,G:H"))
If Application.CountIf(Range(Cells(2, Cell.Column), Cell.Offset(-1)), "") Or (Cell.Value = "" _
And Cell.Offset(1).Value <> "") Then
MsgBox "Cannot Enter Data if the cell above it is blank " & vbNewLine & _
"Nor Delete Data if there is a non-blank cell below it!", vbExclamation
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit For
End If
Next
OutOfRange:
End Sub
Jun 23 2018 09:58 PM
Mr Kim,
It is an interesting question. I did not encounter such problem before. I hope the following code can serve the purpose.
Private Sub worksheet_change(ByVal Target As Range)
Application.EnableEvents = False
r = Target.Row
c = Target.Column
Select Case c
Case 4
Cells(r, c + 3).Select ' select the corresponding cells in column G
Case 7
If Len(Target) = 0 And Cells(r, c - 3) > 0 Then
MsgBox ("You have to delete column D first")
Application.Undo ' undo the delete
Else
If Val(Target.Value) <= 0 And Cells(r, c - 3) > 0 Then
MsgBox ("Input a postive value")
Target.Select ' select the corresponding cell
End If
End If
End Select
Application.EnableEvents = True
End Sub
Thanks for your question and I learn something new. Hope that it is helpful to you.
Jun 23 2018 10:32 PM
Mr. Chan
It almost work perfectly..
the moment I inputted D the cursor goes to G and when I entered number zero or less - it captures the error. when D & G are filled - erasing G is prevented - nice!!
BUT..the glitch is that when the cursor goes to G and I strike Enter key - the cursor just went down, it did not capture the error.
I hv an idea for all scenarios -just one message: "[G] can not be empty if [D] is not!"
many many thanks and good health
Jun 23 2018 11:20 PM
I have no idea to prevent the situation. Just modify the codes using an inputbox for inputting value in column G.
Private Sub worksheet_change(ByVal Target As Range)
Application.EnableEvents = False
r = Target.Row
c = Target.Column
Select Case c
Case 4
If Len(Target) = 0 Then GoTo skip_inputG
inputG:
x = InputBox("Input value in G")
If Val(x) <= 0 Then
MsgBox ("Column G requires a positive value. Please re-input")
GoTo inputG
End If
If Len(x) = 0 Then
MsgBox ("Empty input not valid")
GoTo inputG
End If
Cells(r, 7) = x
skip_inputG:
Cells(r, c + 3).Select ' select the corresponding cells in column G
Case 7
If Len(Target) = 0 And Cells(r, c - 3) > 0 Then
MsgBox ("You have to delete column D first")
Application.Undo ' undo the delete
Else
If (Val(Target.Value) <= 0 And Cells(r, c - 3) > 0) Then
MsgBox ("Input a postive value")
Target.Select ' select the corresponding cell
End If
End If
End Select
Application.EnableEvents = True
End Sub
Let's see if it is good.
Jun 24 2018 12:44 AM
Mr. Chan
It does the trick!
Your designation of 'contributor' is an understatement!
In my book you are MVP!!!
Not just because you have the skill of programming but because you go out of your way to help someone who needed it!
Thank you very very much.
wishing you more power in all of your endeavors and good health.
Jun 24 2018 12:59 AM
I just tried my best to help.
Actually, I need to thank you for your question. In helping you your problem, I learn new thing which may be useful in my other excel work. Thank you.
Let's discuss any excel problem in the future. Wish you all good.
Jun 24 2018 03:35 PM
Mr. Chan
Thank you and best wishes...
Jul 08 2018 09:18 PM
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 i
End Sub
Jul 08 2018 09:20 PM
addendum:
the column is sorted
Jul 09 2018 01:02 AM
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 sub
But 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
Jul 09 2018 01:02 AM
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 sub
But 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
Jul 09 2018 01:24 AM
Mr. Chan
It worked perfectly.
did not affect any other column.
Thank you very very much for your time and unwavering assistance.
Wish you the best of everything..
Jul 09 2018 01:51 AM
Mr. Chan
Pardon me if I pass this query to you, I noticed that your codes are in a box, I asked Mr. Wyn Hopkins and he told me to find </> icon but I couldn't find it. Also I wanted to attach an excel file (.xlsm) - Mr. Damien Rosario said that there is a Browse button below - which again I could not find. Mr. Rosario told me that maybe because the file is macro enabled and was blocked.
Both of them (like yourself and some others) are very helpful.. I am very lucky to have known you all.
Maybe my message box is different from theirs or maybe yours. I am attaching an image for your reference.
many many many thanks
Jul 09 2018 02:28 AM
Dear Kim,
For the box, I am using Format in the tool bar and then choose "Block" --> "Pre".
The community does not allow to attach xlsb/xlsm file. There must have some reasons behind it.
Cheers,
Chan M F
Jul 09 2018 02:52 AM
Mr. Chan
Below is the code that I intend to send to Mr. Kerr who had the query of Find and delete duplicates.
thanks to you, I have replaced the delete entire row. This is my way of pay it forward.
This is the best that I can do to return the help to someone.
Thank you so much for your unwavering assistance.
Sub CutPasteSortAndDeleteDuplicates()
Dim LastRowA As Long
With ActiveSheet
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim LastRowB As Long
With ActiveSheet
LastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Range("B2:B" & LastRowB).Select
Selection.Cut
Range("A" & LastRowA + 1).Select
ActiveSheet.Paste
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A2:A" & LastRow).Select
For Each x In Selection
x.Value = UCase(x.Value)
'x.Value = LCase(x.Value)
'x.Value = WorksheetFunction.Proper(x.Value)
Next
Range("A2:A" & LastRow).Select
ActiveWorkbook.Worksheets("record").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("record").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("record").Sort
.SetRange Range("A2:A" & LastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'courtesy of Mr. Man Fai Chan 7-9-2018
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
Range("A2").Select
End Sub