vba for - delete rows with incomplete data in a worksheet

[Lorenzo Kim]

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

[#2]

Mr. Chan

so sorry to hear that..

Hope you are now OK.

Thank you

[#3]

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

[#4]

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

[#5]

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. 

[#6]

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

[#7]

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.

[#8]

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.

[#9]

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. 

[#10]

 Mr. Chan

Thank you and best wishes...

[#11]

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

[#12]

addendum:

the column is sorted

[#13]

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

[#14]

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

[#15]

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..

[#16]

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

[#17]

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

[#18]

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