Loop through Range and highlight rows when parameter met.

[DrParmeJohnson]

Hello, I have been struggling to get this macro to work in totality and this part has been giving me troubles.

I currently have two loops which do similar things, but I can't get them to work.

    Dim i As Variant
    For Each i In Range("F2:F" & Lastrow).Cells
    If i.Value > 0.1 & i.Value < 1 Then
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 7434751
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
    Next i
    Dim c As Variant
    For Each c In Range("F2:F" & Lastrow).Cells
    If c.Value < 0.1 & c.Value > 0 Then
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
        End With
    End If
    Next c

Ths isn't the whole macro so not everything is defined here.

What I'm trying to make the first do is loop through from F2 to Lastrow and for each cell where the value is greater than .1 and less than 1 (the values are written in percentage form "0.00%") and for the values that are in that range, highlight them red.
And for the second loop, it does the same but in the range where it is less than .1 and greater than 0 and then highlight that green.

I've mostly just cannibalized most of this macro from the recorder and other things I have found online and I am not sure what actually works together and why this isn't working properly.
Any other questions on things I may have left out, please ask, I am quite sick of dealing with these loops.

Thanks.

 

[MPW]

Don't know if this will help, but here is another way to look at it.

    Dim r1 As Long
    Dim all As Long
    all = Cells(Rows.Count, 6).End(xlUp).Row
    r1 = 0
    For r1 = 2 To all
        If Cells(r1, 6) > 0.1 And Cells(r1, 6) < 1 Then
            Cells(r1, 6).Interior.Color = RGB(255, 0, 0)
        ElseIf Cells(r1, 6) < 0.1 And Cells(r1, 6) > 0 Then
            Cells(r1, 6).Interior.Color = RGB(0, 255, 0)
        End If
    Next r1

I do not have access to your values, but I hope this helps.

 

[DanteAmor]

The following happens: You must not use "&" (with this concatenate the 2 conditions), you must use "And".
Instead of With Selection.Interior you must refer to the object "c": c.Interior.Color

check the following

Sub test()
    Dim c As Range
    For Each c In Range("F2", Range("F" & Rows.Count).End(xlUp))
      If c.Value > 0.1 And c.Value < 1 Then c.Interior.Color = vbRed
      If c.Value < 0.1 And c.Value > 0 Then c.Interior.Color = vbGreen
    Next c
End Sub

________________________________________________________
Note: 0.1 is not defined in your conditions, that value will not be painted in any color.

 

[Norie]

Why not use conditional formatting?

 

[DrParmeJohnson]

I used Dante's solution and it worked for me. The whole bulk of my code is a mess so I didn't want to post it all but, I'm going to just to see if anyone has any optimization tips or if I have any redundant things in here.

Option Explicit

Sub cBulkBuy_Discounts()
'
' cBulkBuy_Discounts Macro
' Organize and calculate requested bulk orders from Amazon
'

'
    Application.ScreenUpdating = False
    Sheets.Add(After:=Sheets("Requests")).Name = "Discounts"
    Sheets("Requests").Select
    Range("B:B,C:C,E:E,F:F,H:H").Copy
    Sheets("Discounts").Select
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.Run "PERSONAL.xlsb!bItemTitles"
    Application.Run "PERSONAL.xlsb!bItemTitles"
    Cells.EntireColumn.AutoFit
    Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1").FormulaR1C1 = "Item#"
    Range("F1").FormulaR1C1 = "Discounts"
    Dim Lastrow As Integer
    Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Range("F$2:F" & Lastrow).FormulaR1C1 = "=RC[-2]/RC[-1] - 1"
    Range("D2:E" & Lastrow).NumberFormat = "$0.00"
    Range("F2:F" & Lastrow).NumberFormat = "0.00%"
    ActiveWorkbook.Worksheets("Discounts").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Discounts").Sort.SortFields.Add2 Key:=Range("F1") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Discounts").Sort
        .SetRange Range("A2:G" & Lastrow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' ---------------------------------------------------------------------------------------------
    Dim c As Range
    For Each c In Range("F2", Range("F" & Rows.Count).End(xlUp))
      If c.Value > 0.1 And c.Value < 1 Then c.Interior.Color = vbRed
      If c.Value < 0.1 And c.Value > 0 Then c.Interior.Color = vbGreen
    Next c
    ' ---------------------------------------------------------------------------------------------
    Cells.Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    Range("A1").Select
    Application.Run "PERSONAL.xlsb!cASIN_LD"
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Here's some sample data as well.
Formula in F = D2/E2 - 1 and so on down the column.

A:Product Name	B:ASIN	C:Item#	D:Price	E:Discounted Price	F:Discounts
xxxxxx	xxxxxx	xxxxxx	$10.50	$10.00	5.00% (Green)
xxxxxx	xxxxxx	xxxxxx	$5.00	$4.00	25.00% (Red)

 

[DanteAmor]

Try this

Sub cBulkBuy_Discounts()
'
' cBulkBuy_Discounts Macro
' Organize and calculate requested bulk orders from Amazon
'
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Lastrow As Integer, c As Range
 
  Set sh1 = Sheets("Requests")
 
  Application.ScreenUpdating = False
  Sheets.Add(After:=Sheets(sh1.Name)).Name = "Discounts"
  Set sh2 = Sheets("Discounts")
    
  sh1.Range("B:B,C:C,E:E,F:F,H:H").Copy
  sh2.Select
  sh2.Range("A1").PasteSpecial Paste:=xlPasteValues
  Application.Run "PERSONAL.xlsb!bItemTitles"
  Application.Run "PERSONAL.xlsb!bItemTitles"
  sh2.Cells.EntireColumn.AutoFit
  sh2.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  sh2.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  sh2.Range("C1").FormulaR1C1 = "Item#"
  sh2.Range("F1").FormulaR1C1 = "Discounts"
  Lastrow = sh2.Cells(Rows.Count, "A").End(xlUp).Row
  sh2.Range("F$2:F" & Lastrow).FormulaR1C1 = "=RC[-2]/RC[-1] - 1"
  sh2.Range("D2:E" & Lastrow).NumberFormat = "$0.00"
  sh2.Range("F2:F" & Lastrow).NumberFormat = "0.00%"
    
  sh2.Range("A2:G" & Lastrow).Sort key1:=sh2.Range("F1"), order1:=xlDescending, Header:=xlNo
    
  For Each c In sh2.Range("F2", sh2.Range("F" & Rows.Count).End(xlUp))
    If c.Value > 0.1 And c.Value < 1 Then c.Interior.Color = vbRed
    If c.Value < 0.1 And c.Value > 0 Then c.Interior.Color = vbGreen
  Next c
  With sh2.Range("A2:G" & Lastrow).Borders
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.249946592608417
    .Weight = xlThin
  End With
  Range("A1").Select
  Application.Run "PERSONAL.xlsb!cASIN_LD"
  Application.ScreenUpdating = True
  Application.CutCopyMode = False

End Sub

 

[DrParmeJohnson]

Try this

Sub cBulkBuy_Discounts()
'
' cBulkBuy_Discounts Macro
' Organize and calculate requested bulk orders from Amazon
'
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Lastrow As Integer, c As Range

  Set sh1 = Sheets("Requests")

  Application.ScreenUpdating = False
  Sheets.Add(After:=Sheets(sh1.Name)).Name = "Discounts"
  Set sh2 = Sheets("Discounts")
   
  sh1.Range("B:B,C:C,E:E,F:F,H:H").Copy
  sh2.Select
  sh2.Range("A1").PasteSpecial Paste:=xlPasteValues
  Application.Run "PERSONAL.xlsb!bItemTitles"
  Application.Run "PERSONAL.xlsb!bItemTitles"
  sh2.Cells.EntireColumn.AutoFit
  sh2.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  sh2.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  sh2.Range("C1").FormulaR1C1 = "Item#"
  sh2.Range("F1").FormulaR1C1 = "Discounts"
  Lastrow = sh2.Cells(Rows.Count, "A").End(xlUp).Row
  sh2.Range("F$2:F" & Lastrow).FormulaR1C1 = "=RC[-2]/RC[-1] - 1"
  sh2.Range("D2:E" & Lastrow).NumberFormat = "$0.00"
  sh2.Range("F2:F" & Lastrow).NumberFormat = "0.00%"
   
  sh2.Range("A2:G" & Lastrow).Sort key1:=sh2.Range("F1"), order1:=xlDescending, Header:=xlNo
   
  For Each c In sh2.Range("F2", sh2.Range("F" & Rows.Count).End(xlUp))
    If c.Value > 0.1 And c.Value < 1 Then c.Interior.Color = vbRed
    If c.Value < 0.1 And c.Value > 0 Then c.Interior.Color = vbGreen
  Next c
  With sh2.Range("A2:G" & Lastrow).Borders
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.249946592608417
    .Weight = xlThin
  End With
  Range("A1").Select
  Application.Run "PERSONAL.xlsb!cASIN_LD"
  Application.ScreenUpdating = True
  Application.CutCopyMode = False

End Sub

Worked like a charm, thanks for the help. I wasn't expecting the whole clean up so that is greatly appreciated. Appeals to my OCD lol.

Thanks again.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.