Code for deleting entire row

G

gregork

I have a button(CommandButton1) I want to use for deleting entire rows of a
list(Sheet 2) that has data inputted via a user form. On Sheet 1 range
B7:B22 I have the components that I want to delete e.g apples, oranges,etc.
from the list on sheet 2. The trouble is they must only be deleted if they
correspond to an order number eg (2013654) which is on Sheet 1 cell O3. On
Sheet 2 I have a column (I:I) that combines the order number and the
component eg (2013654apple). I put this in as a sort of unique i.d.
So in summary when I click the button I want the code to find all the
components from Sheet 1 on Sheet 2 that correspond to the order number on
Sheet 1 and then delete the entire row. I hope somebody out there can
understand this and thanks for taking the time to read it all.

Regards
gregorK
 
R

Rob van Gelder

So long as you're consistent about your Product Names (Orange, not Oranges)
then this will likely do what you're after:


Sub test()
Dim lngLastRow As Long, rngOrder As Range, rngProduct As Range
Dim rngOrderItem As Range, rngDelete As Range

Set rngOrder = Worksheets("Sheet1").Range("O3")
lngLastRow = Worksheets("Sheet2").Range("I" & Rows.Count).End(xlUp).Row
For Each rngProduct In Worksheets("Sheet1").Range("B7:B22")
For Each rngOrderItem In Worksheets("Sheet2").Range("I1:I" &
lngLastRow)
If rngOrderItem.Value = rngOrder.Value & rngProduct.Value Then
If rngDelete Is Nothing Then
Set rngDelete = rngOrderItem.EntireRow
Else
Set rngDelete = Union(rngDelete, rngOrderItem.EntireRow)
End If
End If
Next
Next

If Not rngDelete Is Nothing Then
rngDelete.Delete xlShiftUp
End If
End Sub
 
Top