VBA Code needed to insert rows based on pricepoints

Hi,
I have attached a cut down version of the data I'm trying to sort.
Column A has product, and column B has a Sell price.
I'm stuck on creating the code to look through the list of prices in column B, and insert blank rows to seperate the list into set pricegroups.
Eg. 0 - 499 / 500 - 799 / 800 - 999 / 1000 - 1499 / 1500 - 1999 / 2000 - 2499 / 2500 - 2999 / 3000 - 3499 / 3500 - 3999 / 4000 - 4499 / 4500 - 4999

Any help or advice would be greatly appreciated.

I think this is what you wanted

Code:

---

Option Explicit
Sub InsertPricePoints()
    Dim aryPoints As Variant
   
    aryPoints = Array(0, 500, 800, 1000, 1500, 2000, 2500, 3000, 3500, 4000, 4500)
   
    Dim iRow As Long
   
    Application.ScreenUpdating = False
   
    With ActiveSheet
        For iRow = .Range("B3").CurrentRegion.Cells(1, 1).End(xlDown).Row To .Range("B3").Row + 1 Step -1
            If Application.WorksheetFunction.Match(.Cells(iRow, 2).Value, aryPoints, 1) <> Application.WorksheetFunction.Match(.Cells(iRow - 1, 2).Value, aryPoints, 1) Then
                .Rows(iRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next iRow
    End With
    Application.ScreenUpdating = True

End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

I think this is what you wanted

Code:

---

Option Explicit
Sub InsertPricePoints()
    Dim aryPoints As Variant
   
    aryPoints = Array(0, 500, 800, 1000, 1500, 2000, 2500, 3000, 3500, 4000, 4500)
   
    Dim iRow As Long
   
    Application.ScreenUpdating = False
   
    With ActiveSheet
        For iRow = .Range("B3").CurrentRegion.Cells(1, 1).End(xlDown).Row To .Range("B3").Row + 1 Step -1
            If Application.WorksheetFunction.Match(.Cells(iRow, 2).Value, aryPoints, 1) <> Application.WorksheetFunction.Match(.Cells(iRow - 1, 2).Value, aryPoints, 1) Then
                .Rows(iRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next iRow
    End With
    Application.ScreenUpdating = True

End Sub

---

---

Thanks Paul, you're a champion. Love ya work.

Hi,
I am trying to find a code solution to delete entire row, if they have red color format (255) in Column A (column C has color formatted cells also, but they aren't considered to the rows to be deleted...only the color rows of column A are the basis to delete entire row.)
Have tried numerous solutions, to no avail.

Any help is greatly appreciated.

Regards,
Doug.

1. Very similar to first macro. When deleting rows, better to start at bottom and work up

2. You used conditional formatting, but I went to the cell contents to check

Code:

---

Option Explicit
Sub DeleteRed()
    Dim iRow As Long
   
    Application.ScreenUpdating = False
   
    With ActiveSheet
        For iRow = .Range("A3").CurrentRegion.Cells(1, 1).End(xlDown).Row To .Range("A3").Row Step -1
            If InStr(UCase(.Cells(iRow, 1).Value), "RESALE") > 0 Or InStr(UCase(.Cells(iRow, 1).Value), "DEMO") > 0 Then
                .Rows(iRow).Delete
            End If
        Next iRow
    End With
    Application.ScreenUpdating = True
End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

1. Very similar to first macro. When deleting rows, better to start at bottom and work up

2. You used conditional formatting, but I went to the cell contents to check

Code:

---

Option Explicit
Sub DeleteRed()
    Dim iRow As Long
   
    Application.ScreenUpdating = False
   
    With ActiveSheet
        For iRow = .Range("A3").CurrentRegion.Cells(1, 1).End(xlDown).Row To .Range("A3").Row Step -1
            If InStr(UCase(.Cells(iRow, 1).Value), "RESALE") > 0 Or InStr(UCase(.Cells(iRow, 1).Value), "DEMO") > 0 Then
                .Rows(iRow).Delete
            End If
        Next iRow
    End With
    Application.ScreenUpdating = True
End Sub

---

---

Thanks Paul, worked a treat.

Doug