steveo0707

Board Regular
Joined
Mar 4, 2013
Messages
85
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Below is a sample of the current code I am using in excel to highlight cells when our products are in a box. The code worked fine until I increased the number of Rows it needed to go through.

I'm not very good with loops so need some help rewriting this as a loop;so it can scan 200 rows x 7 columns wide.

Ideally, I would want the code to scan all rows and look for three things. Scan Column E for the words "Working On" then Select cell in Column A and highlight it Yellow. Scan through Column E for the words "In Box" then Select Cells in Column A & B and Highlight Yellow. Then I need it to Scan Column F for the letter "D" and then select Cell in column C and highlight an off green color.

Any help would be greatly appreciated


Code:
Sub ClearCells()'
' Clear Cells Once PArts Have Shipped
'
Application.ScreenUpdating = False


     Range("H3").Select
    If ActiveCell.FormulaR1C1 = "Shipped" Then
     Range("A3:G3").Select
     Range("A3:G3").ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
     Range("H4").Select
    If ActiveCell.FormulaR1C1 = "Shipped" Then
     Range("A4:G4").Select
     Range("A4:G4").ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
     Range("H5").Select
    If ActiveCell.FormulaR1C1 = "Shipped" Then
     Range("A5:G5").Select
     Range("A5:G5").ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Here is some code that loops through each row until it reaches an empty Column E and highlights as you discribed above (just delete the Column F stuff that doesn't apply).
Code:
Sub Scanning()
    Dim YELLOW As Variant
    Dim OFF_GREEN As Variant
    Dim Row As Long
    ' DEFINE THE COLORS
    YELLOW = RGB(255, 255, 0)
    OFF_GREEN = RGB(223, 240, 226)
    ' CYCLE THROUGH ROWS
    Row = 1
    Do Until Range("E" & Row).Value = VBA.Constants.vbNullString
        ' CHECKING COLUMN E
        Select Case Range("E" & Row).Value
            Case "Working On"
                Range("A" & Row).Interior.Color = YELLOW
            Case "In Box"
                Range("A" & Row & ":B" & Row).Interior.Color = YELLOW
        End Select
        ' IF YOU ARE LOOKING FOR JUST A LETTER D IN COLUMN F
        If Range("F" & Row).Value = "D" Then Range("C" & Row).Interior.Color = OFF_GREEN
        ' IF YOU ARE LOOKING FOR THE CELL TO CONTAIN A LETTER D IN COLUMN F
        If VBA.Strings.InStr(Range("F" & Row).Value, "D") > 0 Then Range("C" & Row).Interior.Color = OFF_GREEN
        Row = Row + 1
    Loop
End Sub
Please remember to back up your work before running new code.

Hope this helps!
 
Last edited:
Upvote 0
This is another way:

Code:
Sub scan_rows()
    lr = Range("E" & Rows.Count).End(xlUp).Row
    Range("A:B, C:C").Interior.ColorIndex = xlNone
    Range("A:F").AutoFilter 5, "Working On"
    ActiveSheet.Range("A2:A" & lr).Interior.ColorIndex = 6
    Range("A:F").AutoFilter 5, "In Box"
    ActiveSheet.Range("A2:B" & lr).Interior.ColorIndex = 6
    ActiveSheet.ShowAllData
    Range("A:F").AutoFilter 6, "D"
    ActiveSheet.Range("C2:C" & lr).Interior.ColorIndex = 10
    ActiveSheet.ShowAllData
End Sub
 
Upvote 0
Hello Rosen and DanteAmor,

Rosen, I tried running your code and I'm getting nothing.

DanteAmor, I ran your code and it is highlighting the "in box" and the "D" correctly, but it is highlighting every Cell in Column A yellow down to row 114 and stops. I currently do not have anything that says working on in column E

Thank You both for your help so far!

Stephen
 
Upvote 0
Quick Update,

Rosen, When I run yours It is only highlighting the first Cell corresponding to the cell that has a "D" in it. No yellow highlighting is happening at all.

Steve
 
Upvote 0
Another Quick Update,

DanteAmor,

When I put in the Working On on the associated cells, your code works perfectly! Exactly what I was looking for!

Again Thank you both for your help and suggestions!

Have a Great Day!

Steve
 
Upvote 0
Hello Rosen and DanteAmor,

Rosen, I tried running your code and I'm getting nothing.

DanteAmor, I ran your code and it is highlighting the "in box" and the "D" correctly, but it is highlighting every Cell in Column A yellow down to row 114 and stops. I currently do not have anything that says working on in column E

Thank You both for your help so far!

Stephen

Use this please

Code:
Sub scan_rows()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Application.ScreenUpdating = False
    On Error Resume Next
    lr = sh.Range("E" & Rows.Count).End(xlUp).Row
    sh.Range("A:B, C:C").Interior.ColorIndex = xlNone
    sh.Range("A:F").AutoFilter 5, "Working On"
    sh.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 6
    sh.Range("A:F").AutoFilter 5, "In Box"
    sh.Range("A2:B" & lr).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 6
    sh.ShowAllData
    sh.Range("A:F").AutoFilter 6, "D"
    sh.Range("C2:C" & lr).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 10
    sh.ShowAllData
End Sub
 
Upvote 0
Another Quick Update,

DanteAmor,

When I put in the Working On on the associated cells, your code works perfectly! Exactly what I was looking for!

Again Thank you both for your help and suggestions!

Have a Great Day!

Steve



With the updated code you will not have problems when there is no data
 
Upvote 0

Forum statistics

Threads
1,214,429
Messages
6,119,433
Members
448,897
Latest member
ksjohnson1970

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top