Find cell value, set cell shading

[Ladymuck]

I hope I can explain this ok!

Worksheet A is laid out as:

ID Task1 Task2 Task3 Task4
1 dd/mm/yy dd/mm/yy dd/mm/yy dd/mm/yy
2 dd/mm/yy dd/mm/yy dd/mm/yy dd/mm/yy
3 dd/mm/yy dd/mm/yy dd/mm/yy dd/mm/yy

etc

Worksheet B is laid out as:
ID Task1 Task2 Task3 Task4
1 complete on hold not started not started
2 complete complete complete not started
3 not started not started not started not started

etc

Not everything on Worksheet B can be found on Worksheet A and vice versa

What I need to do:
Is the ID on A found in B?
If yes, look along the row and where something is 'complete' on B, set the
corresponding cell on A as Blue interior, White text.
Otherwise, do nothing

In the example above, cells B2, B3, C3, and D3, would all be Blue/White. The
cell contents of A cannot be overwritten. Worksheet B is deleted once the
macro has finished running as it is just a temporary data store for doing
other background functions.

I have Chip Pearson's (thanks Chip!) fabulous modColorFunctions installed as
I've used it elsewhere in this workbook if that is of use here.

Thanks in advance for any help, all comments gratefully received.

Louise

 

[Rick Rothstein \(MVP - VB\)]

You don't need to use a macro to do what you asked, you can do it using
Conditional Formatting. Go to "Worksheet B" and select Cell B2, click in the
Name Box (that is the edit field on the formula bar to the left of the
formula fill-in field) and type in StartCell for its name (you can use any
name you want, but if you change it from this, you will have to change the
conditional formula below to match). Okay, now go back to "Worksheet A" and,
starting in Cell B2, select all your potential Task columns for as many row
down as you think you may ever have ID numbers entered (that is, don't be
afraid to include blank cells in the range). With that range still selected,
click on Format/Conditional Formatting on the Excel menu bar; select Formula
Is from the first drop-down and put this formula in the 2nd field...

=ISNUMBER(MATCH("Complete",OFFSET(StartCell,ROW(B2)-2,COLUMN(B2)-2),0))

Next, click the Format button and choose White for the color of your text on
the Font tab and the Blue color you want for the interior of the cells on
the Patterns tab. Now, OK your way back to the worksheet and the appropriate
cells should be highlighted.

Rick

 

[Ladymuck]

Thanks for the suggestion Rick. I have considered using named ranges in
conditional formatting but, unfortunately, Worksheet B is automatically
deleted at the end of the macro as it is huge and contains more data than is
needed for the report. It's simply imported, used as source data to run
several calculations and then removed. If I was retaining it then what you
have suggested would be ace.

 

[Rick Rothstein \(MVP - VB\)]

Can you not delete the worksheet and simply delete the excess data on it
instead (leaving the task data in place until the next import when
everything would again be overwritten)? That way the named cell would always
remain in place from import to import and the only data you would have to
'tolerate' remaining around would be just the task data. Or is this task
data the huge part of the worksheet?

Rick

 

[Ladymuck]

The full data import is about 2000 lines and 100 columns. Worksheet A is a
summary of some of that data in a more management style. ;-)

I have now copied to a distant part of Worksheet A the status of each task
so it is on the same line as its corresponding ID. The range is currently
15x300 cells and although I could set conditional formatting to pick up the
word Complete and change the cell, I cannot think of a way of copying/pasting
the conditional format only. There is existing formatting on these cells that
cannot be overwritten and the thought of manually doing each cell's
conditional format fills me with dread!

I have therefore tried to do the following:

Dim r As Range
Dim c As Range

LastRow = Cells(Rows.Count, "AK").End(xlUp).Row
Set r = Range("CG14:CU" & LastRow)

For Each c in r
If c.Value = "Complete" Then
Cells(c.Row,c.Column - 30).Interior.ColorIndex = 5
Cells(c.Row,c.Column - 30).Font.ColorIndex - 2
End If
Next

But I get error 13 Type Mismatch on the If c.Value = "Complete" Then line.
Hovering over it, I see another error 2402, which I cannot find in help and a
quick google search implies that the value cannot be found.

Any suggestions as ever gratefully received!

Louise

 

[Rick Rothstein \(MVP - VB\)]

I may be missing something, but if you have copied over the data with the
task status of Complete (or other designations) in them to Columns CG:CU
starting at Row 14 (not 2 as your original post would have suggested?), why
can't you still use a simple Conditional Format? If I read your code
correctly, the data with your dates in them are located 30 columns in front
of Columns CG:CU which would be Columns BC:BQ if I calculated correctly. If
you highlight these columns across for, say, 500 rows down (I know you said
300 rows, but I built in some cushioning), that is, select the range
BC14:BQ514, and Conditionally Format this with the formula

=ISNUMBER(MATCH("Complete",OFFSET($CG$14,ROW(BC14)-14,COLUMN(BC14)-55),0))

then I would think you would get the result you want without having to loop
through each cell individually inside your macro seeing if its ColorIndex
needs to be changed or not.

Rick

 

[Office_Novice]

I have been working on somthing similar to what your doing, maybe this will
get you started.

Sub Compare()
Dim foundcell As Range
With Worksheets(2).Range("A1:A65536")

Do
On Error Resume Next
Set foundcell = .Find(What:=ActiveCell.Value, lookAt:=xlWhole,
LookIn:=xlValues, SearchOrder:=xlRows, MatchCase:=True, MatchByte:=True)

If Not foundcell Is Nothing Then
ActiveCell.Offset(0, 2).Value = "Found " & ActiveCell.Value & " in "
& "Sheet2 " & foundcell.Address
ActiveCell.Offset(0, 2).Interior.ColorIndex = 41
ActiveCell.Offset(0, 2).Font.ColorIndex = 2
ElseIf foundcell Is Nothing Then
ActiveCell.Offset(0, 2).Value = "Didn't Find " & ActiveCell.Value &
" in " & "Sheet2 "
ActiveCell.Offset(0, 2).Interior.ColorIndex = 3
ActiveCell.Offset(0, 2).Font.ColorIndex = 2
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
End With
End Sub

 

[Ladymuck]

The cells which need the Blue/White colouring already have formatting in them
of other colours that are not determined by conditional formats. If I apply a
conditional format and paste it over the range, I will wipe out the manual
formatting and will have to reapply it. The other alternative is to
individually set the conditional formatting on each cell. Neither of these is
an efficient use of time hence why I wanted to do this via a macro.

 

[Rick Rothstein \(MVP - VB\)]

Your use of the word "paste" in the sentence "If I apply a conditional
format and paste it over the range"... there is no manual "paste" operation
associated with Conditional Formatting.

To the best of my knowledge, the colors applied via the Conditional
Formatting do not permanently wipe out the underlying (manually applied)
colors assigned to the cells; rather, they just "push" them out of the way
while the condition is TRUE... as soon as the condition becomes FALSE, the
original manually applied cell colors are restored.

Rick

 

[Peter T]

But I get error 13 Type Mismatch on the If c.Value = "Complete" Then line.

Only reason for I can think of for that is if the cell contains an error,
but why though

Have a go with the following to have your cake and eat it. Run Test then
goto BC14 and CG14


Sub Test()

Worksheets.Add
SampleData
NormalFormat
CondFormat

End Sub

Sub SampleData()
Dim i As Long
Const TopRow As Long = 14
Const LastRow As Long = 28
Cells.Clear

Range("AK" & TopRow & ":AK" & LastRow).Value = "some-ID"
With Range("BC" & TopRow & ":BQ" & LastRow)
.Value = Date
With .Offset(, 30)
For i = 1 To .Count
If i Mod 4 = 1 Then
.Cells(i) = "Pears" ' for Cond-Format
ElseIf i Mod 4 = 3 Then
.Cells(i) = "Apples" ' for Normal format
End If
Next
.Cells(1) = CVErr(xlErrNA) ' just for fun
End With
End With

End Sub

Sub NormalFormat()
Dim LastRow As Long
Dim rng As Range, c As Range

LastRow = Cells(Rows.Count, "AK").End(xlUp).Row
Set rng = Range("CG14:CU" & LastRow)

With rng.Offset(, -30)
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
End With

For Each c In rng
If IsError(c.Value) Then ' hmm...
Cells(c.Row, c.Column - 30).Interior.ColorIndex = 1 ' black
Cells(c.Row, c.Column - 30).Font.ColorIndex = 2 ' white
ElseIf c.Value = "Apples" Then
Cells(c.Row, c.Column - 30).Interior.ColorIndex = 5 ' blue
Cells(c.Row, c.Column - 30).Font.ColorIndex = 2 ' white
End If
Next

End Sub

Sub CondFormat()
Dim sFla As String
Dim nColOffset As Long
Dim LastRow As Long
Dim rng As Range
Dim fc As FormatCondition

LastRow = Cells(Rows.Count, "AK").End(xlUp).Row

Set rng = Range("BC14:BQ" & LastRow)

sFla = "=RC[#]=""Pears"""
nColOffset = 30 '

sFla = Replace(sFla, "#", CStr(nColOffset))

With rng
.FormatConditions.Delete
Set fc = .FormatConditions.Add(Type:=xlExpression, Formula1:=sFla)
End With

fc.Interior.ColorIndex = 3 ' red
fc.Font.ColorIndex = 6 ' yellow

End Sub

Regards,
Peter T