Identify cells for deletion

JimmyB · Jul 19th 2020

Hi. Struggling with a little problem. In my program I choose a particular cell and double click it. this activates the sub which in turn deletes the complete row. That is exactly what it was designed to do, but now I've added a feature to the program which is housed to the right of the cells that are to be deleted. Since it is deleting the complete row, it messes up my new feature. Below is the portion of code:

X is the cell in column 'A' that is activated.

I need it to delete only the cells in row x from column 'A' to 'L' then shift:=xlUp

Any help will be greatly appreciated

Thanks

JimmyB

Code

With Target
            x = Application.Match(.Value, Sheets("VALUES for MEALS").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("VALUES for MEALS").Rows(x & ":" & x).Delete Shift:=xlUp
    End With

**royUK** · Jul 19th 2020

If you double click on a cell in the row to delete why use Match?

Is x declared as a Long?

You don't need a With statement in that snippet of code.

JimmyB · Jul 19th 2020

Hi Roy. Thanks for your quick reply.

I did receive the code from someone at Ozgrid and tailored it to fit my requirement of deletion. I'm sure that my adaptations of the code is rudimentary at best, but I made it work. (and it worked perfectly for what I needed). An array would probably condense the length of the code, but I'm not sure how to proceed with that. I've included the full sub below. If you do take the time to help, please take note that I only want to delete up to column "L" (my initial request)

Thanks again and have a great day

Any help will be appreciated

Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        '''When cell in column "A" in Values for meals is double clicked this sub _
            causes all adjacent sheets to also delete the same item

        If Target.Column <> 1 Then Exit Sub
        If Target.Column > 0 Then
 Dim Result
 
            Result = MsgBox("You are about to delete an item from your food listing" & vbNewLine & vbNewLine & _
            "  YES  = DELETE THE ITEM" & vbNewLine & vbNewLine & "  NO  = DO NOT  DELETE", vbExclamation + vbYesNo, "CONFIRM DELETION")
        If Result = vbNo Then
            Exit Sub
        Else:
        '''The above block prompts the user to confirm deletion of complete food item
        
         
Dim x, I As Long
Dim ws As Worksheet
Dim LastRow As Long

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            
    With Target
            x = Application.Match(.Value, Sheets("Calories").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Calories").Rows(x & ":" & x).Delete Shift:=xlUp
    End With

    With Target
            x = Application.Match(.Value, Sheets("Tot Fat").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Tot Fat").Rows(x & ":" & x).Delete Shift:=xlUp
    End With

    With Target
            x = Application.Match(.Value, Sheets("Trans Fat").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Trans Fat").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Cholesterol").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Cholesterol").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Sodium").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Sodium").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Carbs").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Carbs").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Fibre").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Fibre").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Sugar").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Sugar").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Protein").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Protein").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target

            x = Application.Match(.Value, Sheets("VALUES for MEALS").Range("A1:A1000"), 0)
            If Not IsError(x) Then Sheets("VALUES for MEALS").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 

        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = False
        Cancel = True
        
        End If
        End If
        
End Sub

Display More

JimmyB · Jul 19th 2020

I'm gone for the day and will check back tonight if you get a chance to reply

Thanks again

**royUK** · Jul 19th 2020

Maybe

Code

With Target
x = Application.Match(.Value, Sheets("VALUES for MEALS").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("VALUES for MEALS").Range("A" & x & ":L" & x).Delete Shift:=xlUp
End With

But you don't need multiple with statements

Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'''When cell in column "A" in Values for meals is double clicked this sub _
causes all adjacent sheets to also delete the same item


If Target.Column <> 1 Or Target.CountLarge > 1 Then Exit Sub
' If Target.Column > 0 Then
Dim Result


Result = MsgBox("You are about to delete an item from your food listing" & vbNewLine & vbNewLine & _
" YES = DELETE THE ITEM" & vbNewLine & vbNewLine & " NO = DO NOT DELETE", vbExclamation + vbYesNo, "CONFIRM DELETION")
If Result = vbNo Then
Exit Sub
End If
'''The above block prompts the user to confirm deletion of complete food item


Dim x, I As Long
Dim lCalc As Long


With Application
.ScreenUpdating = False
lCalc = .Calculation ''///store current calculation settings
.Calculation = xlCalculationManual


With Target
x = Application.Match(.Value, Sheets("Calories").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Calories").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Tot Fat").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Tot Fat").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Trans Fat").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Trans Fat").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Cholesterol").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Cholesterol").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Sodium").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Sodium").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Carbs").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Carbs").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Fibre").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Fibre").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Sugar").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Sugar").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("Protein").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("Protein").Range("A" & x & ":L" & x).Delete Shift:=xlUp
x = Application.Match(.Value, Sheets("VALUES for MEALS").Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets("VALUES for MEALS").Range("A" & x & ":L" & x).Delete Shift:=xlUp
End With


.Calculation = lCalc ''///use stored setting
.ScreenUpdating = False
End With
End Sub

Display More

If the value is on the same row in all sheets then it could be further simplified

**royUK** · Jul 19th 2020

Using an array possibly

Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'''When cell in column "A" in Values for meals is double clicked this sub _
causes all adjacent sheets to also delete the same item
Dim wsNames As Variant, Result As Variant, wsName As Variant
Dim x, I As Long, lCalc As Long
If Target.Column <> 1 Or Target.CountLarge > 1 Then Exit Sub
' If Target.Column > 0 Then


Result = MsgBox("You are about to delete an item from your food listing" & vbNewLine & vbNewLine & _
" YES = DELETE THE ITEM" & vbNewLine & vbNewLine & " NO = DO NOT DELETE", vbExclamation + vbYesNo, "CONFIRM DELETION")
If Result = vbNo Then
Exit Sub
End If
'''The above block prompts the user to confirm deletion of complete food item


With Application
.ScreenUpdating = False
lCalc = .Calculation ''///store current calculation settings
.Calculation = xlCalculationManual


wsNames = Array("Calories", "Tot Fat", "Trans Fat", "Cholesterol", "Sodium", "Carbs", "Fibre", "Sugar", "Protein", "VALUES for MEALS")
With Target
For Each wsName In wsNames
With Worksheets(wsName)
x = Application.Match(.Value, Sheets(wsName).Range("A1:A1000"), 0)
If Not IsError(x) Then Sheets(wsName).Range("A" & x & ":L" & x).Delete Shift:=xlUp
End With
Next wsName
End With
.Calculation = lCalc ''///use stored setting
.ScreenUpdating = False
End With
End Sub

Display More

JimmyB · Jul 19th 2020

Thanks Roy. This looks perfect. I'll work on it tonight if i can or tomorrow for sure.

Thanks JimmyB

**royUK** · Jul 20th 2020

Are the rows numbers the same on every sheet?

JimmyB · Jul 20th 2020

Awesome job Roy.

The code to change my deletion from Row to specific range was bang on. I also streamlined my 'with' statements as you've suggested, with success. Tomorrow I'll streamline it even further with your recommendation to use the array in the above code. I can also adapt the array syntax in a few other areas of my program. Great job.

Very much appreciate the help...all of it quite useful

BTW... No the row numbers are not the same. Each sheet is sorted to different columns. Calorie sheet sorted to amount of calories on each food item (lowest to highest), TransFat sorted to amount of transfat (lowest to highest)...an so on. So the rows of food items are all over the map.

It's 2am here. soooo g'nite

Thanks again Roy

JimmyB

**royUK** · Jul 20th 2020

Pleased to help

Identify cells for deletion

Participate now!

Share