Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 390
  • Last Modified:

Turn row red, from a value on a different tab.

This file has serviced us for a long time, however we have found a problem that has caused us to look at an edit.  We need to add a procedure that will do the following:

1.      Check column C, of the MasterList tab for any text that is red.

a.      If it finds red text?  (usually in a group of 5,6,7 etc? Chgs by the file, may need to add a column and remove dups before looking for red text).  After finding one grab the value in column A, and then search, column A of the TemplateLayOut and turn that rows text red also.  It will be there in the TemplateLayout tab.  MasterList tab, creates TemplateLayOut tab.

b.      Search the whole column C in of MasterList until all have been checked, leaving the data intake.  MasterList does not have the same amount of rows each time.

c.      If it does not find any red text in column C of the MasterList, exit sub and done.

Some additional notes that may assist are that it is a dynamic extract, number of columns and rows are never the same.. (unless you extract the same material number¿)  Column C, of MasterList tab is a ValidUntil date and these are no longer being used and we need a way to flag those rows to filter them out.

Need a hand writting this script for VBA.
Please advise and thanks. -R-
AddOOE-FlagsInTemplateLayoutPg.xlsx
0
RWayneH
Asked:
RWayneH
  • 2
  • 2
1 Solution
 
Danny ChildIT ManagerCommented:
Conditional formatting may do this without VBA.
Check Examples 3 and 4 here:
http://www.techrepublic.com/blog/10-things/10-cool-ways-to-use-excels-conditional-formatting-feature/
0
 
byundtCommented:
Here is a macro that uses an AutoFilter on MasterList column C, looking for red font color. It then adds the values from column A of the visible rows to a Dictionary object. Doing so eliminates any duplicates. It then checks worksheet TemplateLayOut column A for the values in the Dictionary and colors them red.

You didn't say whether you wanted just column A colored red or all the data cells in that row. I show both options in the macro (with comments to mark the statements).
Sub RedFontFinder()
Dim cel As Range, rg As Range, rgFilt As Range, targ As Range
Dim dicRed As Object
Dim i As Long, n As Long
Application.ScreenUpdating = False
Set dicRed = CreateObject("Scripting.Dictionary")
With Worksheets("MasterList")
    Set rg = .Cells(1, 3)       'Cells in column C
    Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
    Set rgFilt = rg.Offset(1, 0).Resize(rg.Rows.Count - 1)
End With
With Worksheets("TemplateLayOut")
    Set targ = .Cells(5, 1)     'Cells in column A
    Set targ = Range(targ, .Cells(.Rows.Count, targ.Column).End(xlUp))
    Set targ = Range(targ.Cells(1, 1), targ.Cells(targ.Rows.Count, .Cells(5, .Columns.Count).End(xlToLeft).Column))
End With
rg.Cells(1, 1).AutoFilter
rg.AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
Set rgFilt = rgFilt.SpecialCells(xlCellTypeVisible)

On Error Resume Next
For Each cel In rgFilt.Cells
    dicRed.Add dicRed.Count, cel.Offset(0, -2).Value
Next

n = dicRed.Count
For i = 0 To n
    Set cel = Nothing
    Set cel = targ.Columns(1).Find(dicRed.Item(i))
    If Not cel Is Nothing Then
        'cel.Font.Color = RGB(255, 0, 0)                             'Color just column A font red
        Intersect(cel.EntireRow, targ).Font.Color = RGB(255, 0, 0)  'Color entire row font color red
    End If
Next
On Error GoTo 0
rg.Cells(1, 1).AutoFilter
End Sub

Open in new window

0
 
RWayneHAuthor Commented:
I attached an error screenshot.  It is failing on:
Set rgFilt = rgFilt.SpecialCells(xlCellTypeVisible)

Not sure why.. please advise and thanks. -R-
RedFontError.jpg
0
 
byundtCommented:
I can reproduce your error if the TemplateLayOut worksheet is active, as the wrong column was being filtered on MasterList. The error does not occur if MasterList worksheet is active when macro is launched.

The following code overcomes that issue.
Sub RedFontFinder()
Dim cel As Range, rg As Range, rgFilt As Range, rgx As Range, targ As Range
Dim dicRed As Object
Dim i As Long, n As Long
Application.ScreenUpdating = False
Set dicRed = CreateObject("Scripting.Dictionary")
With Worksheets("MasterList")
    Set rg = .Cells(1, 3)       'Cells in column C
    Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
    Set rgx = rg.Offset(1, 0).Resize(rg.Rows.Count - 1)
End With
With Worksheets("TemplateLayOut")
    Set targ = .Cells(5, 1)     'Cells in column A
    Set targ = Range(targ, .Cells(.Rows.Count, targ.Column).End(xlUp))
    Set targ = Range(targ.Cells(1, 1), targ.Cells(targ.Rows.Count, .Cells(5, .Columns.Count).End(xlToLeft).Column))
End With
rg.Cells(1, 1).AutoFilter
rg.Offset(0, -2).Resize(, 3).AutoFilter Field:=3, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor

On Error Resume Next
Set rgFilt = rgx.SpecialCells(xlCellTypeVisible)
If rgFilt Is Nothing Then
    MsgBox "No cells with red font were found"
    Exit Sub
End If

For Each cel In rgFilt.Cells
    dicRed.Add dicRed.Count, cel.Offset(0, -2).Value
Next

n = dicRed.Count
For i = 0 To n
    Set cel = Nothing
    Set cel = targ.Columns(1).Find(dicRed.Item(i))
    If Not cel Is Nothing Then
        'cel.Font.Color = RGB(255, 0, 0)                             'Color just column A font red
        Intersect(cel.EntireRow, targ).Font.Color = RGB(255, 0, 0)  'Color entire row font color red
    End If
Next
On Error GoTo 0
rg.Cells(1, 1).AutoFilter
End Sub

Open in new window

AddOOE-FlagsInTemplateLayoutPgQ2.xlsm
0
 
RWayneHAuthor Commented:
Works great!!  Thanks!  EXCELent!!  -R-
0

Featured Post

Nothing ever in the clear!

This technical paper will help you implement VMware’s VM encryption as well as implement Veeam encryption which together will achieve the nothing ever in the clear goal. If a bad guy steals VMs, backups or traffic they get nothing.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now