Colouring cell

[InaCell]

Hi all. Thought I could work this out. Have been half successful.
I am trying to colour cells that contain names based on another sheet. To do this I have populated a formula which gives TRUE if it is contained or false if not. This has worked and is written so that it does not loop to speed everything up.
In all my tries to get the macro to not loop, I think I have written over my other code to then colour the cell say red if the cell 2 cols over is TRUE. Nothing to happen if not.
Here is my code;

 Public Sub ColourCell()[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim PrevCalc As Variant[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim x As Long, a As Long, t As String[/SIZE][/FONT]
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
[FONT=Calibri][SIZE=3]With Application[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]  .ScreenUpdating = False[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  .EnableEvents = False[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  PrevCalc = .Calculation[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  .Calculation = xlCalculationManual[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End With[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]For a = 1 To 25 Step 3 'selects columns A D G J M P S[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]  x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]ActiveSheet.Range(Cells(7, a + 2), Cells(x, a + 2)).SpecialCells(xlCellTypeBlanks).Formula = _[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]"=SUMPRODUCT(--ISNUMBER(SEARCH(FNames!R1C1:R3950C1,RC[-2])))>0"[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]  Next a 'goes to next Col in source sheet[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]'For a = 1 To 25 Step 3[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'    x = Cells(Rows.Count, a).End(xlUp).Row[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'    t = "TRUE"[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'            If TypeName(Range(Cells(7, a + 2), Cells(x, a + 2)).Value) = t Then[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'               Range(Cells(7, a), Cells(x, a)).Interior.ColorIndex = 7[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'                   Else[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'               Range(Cells(7, a), Cells(x, a)).Interior.ColorIndex = 0[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'            End If[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'    Next a[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]With Application[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]  .ScreenUpdating = True[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  .EnableEvents = True[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  .Calculation = PrevCalc[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End With[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]End Sub [/SIZE][/FONT]

I have commented out the part that I can’t get to work. I have tried different ways but keep getting nowhere.
Could this be written in a way that the return “TRUE” column was not even needed.
Must remember to back my original codes up!
Cheers
<o></o>
<o></o>

 

[WinteE]

Why don't you use conditional formats ?

Instead of using 'Cell value is' you can use 'Formula is'.

For example conditional format of cell A1 :

=OFFSET(A1,0,1)="Test" means that you change the format of cell A1 based on whether cell B1 contains "Test" or not.

Success

 

[InaCell]

Hi and thanks for the direction.
Have changed code to reflect formula instead of value as suggested.

 Public Sub ColourCell()[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim PrevCalc As Variant[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim x As Long, a As Long[/SIZE][/FONT]
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
[FONT=Calibri][SIZE=3]With Application[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   .ScreenUpdating = False[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   .EnableEvents = False[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   PrevCalc = .Calculation[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   .Calculation = xlCalculationManual[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End With[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]For a = 1 To 19 Step 3 'selects columns A D G J M P S[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]ActiveSheet.Range(Cells(7, a + 2), Cells(x, a + 2)).SpecialCells(xlCellTypeBlanks).Formula = _[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]"=SUMPRODUCT(--ISNUMBER(SEARCH(FNames!R1C1:R3950C1,RC[-2])))>0"[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   Next a 'goes to next Col in source sheet[/FONT][/SIZE]
 
[FONT=Calibri][SIZE=3]For a = 1 To 19 Step 3[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   x = Cells(Rows.Count, a).End(xlUp).Row[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ActiveSheet.Range(Cells(7, a), Cells(x, a)).Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=OFFSET(RC,0,2)=TRUE"[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   With Selection.FormatConditions(1).Interior[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .PatternColorIndex = xlAutomatic[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Color = 255[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .TintAndShade = 0[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   End With[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Next a[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]With Application[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   .ScreenUpdating = True[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   .EnableEvents = True[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   .Calculation = PrevCalc[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End With[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]End Sub[/SIZE][/FONT]

When running, Excel shows “not responding”, how do I stop this?
Also, code is taking 90 seconds to run. Can this be sped up (Data currently covers 6 columns and 3,000 rows). Seems too slow.
Cheers
<o></o>
<o></o>

 

[WinteE]

On www.excelguide.eu you have the option to send me a mail with your file attached.

Guess you can fix this with conditional format in combination with VLOOKUP or something.