conditional format adjacent cell based on value

Question

I need a macro that says: 

: if the adjacent cell in B is "Deleted", change font color to red and bold in column C.

This will be applied to B3:B100000.

Answer 1

Are you trying to find cells in B containing the text "Deleted", or do you want to trigger an action if whatever is in B gets deleted?

If the former, do you need a macro? Simple conditional formatting will do this.

With B3 selected, select conditional formatting, New Rule, choose "Use a formula to determine which cells to format" and for the formula enter =$B1="Deleted" and set the format as you want it. Then copy down to B10000.

Murray

Answer 2

I'm not sure what you meant by "the adjacent cell in B" unless you mean adjacent to column C.

How I looked at it: Looking for "Deleted" in B3:B100000 and if found, then make C on same row font red and bold (otherwise black and not bold).  I've also set it up so if last used row in B is less than 100,000 then that's all that will be examined.  But if you have formulas in B, then it may always do 99,998 anyhow - and it takes a bit of time to do it: about 6 seconds on a 3GHz dual-core system.

Why not just use standard conditional formatting (other than that you'd have 99,998 volatile formulas recalculating every time you changed something/anything on the sheet)?

Sub MakeItRed()

'worksheet with data to test must be active when run

  Const ColToMakeRed = "C" ' change as required

  Const keyPhrase = "DELETED" ' all uppercase for testing

  Const testCol = "B"

  Const firstRow = 3

  Const maxRow = 100000

  Dim lastRow As Long

  Dim offset2RedCol As Integer

  Dim testRange As Range

  Dim anyTestCell As Range

  'see if we can do fewer than 99,998

  lastRow = Range(testCol & Rows.Count).End(xlUp).Row

  'set test range based on fewest rows to have to work with

  'if lastRow > 100,000 then reduce to 100,000

  If maxRow < lastRow Then

    lastRow = maxRow

  End If

  Set testRange = Range(testCol & firstRow & ":" _

   & testCol & lastRow)

  offset2RedCol = _

   Range(ColToMakeRed & 1).Column - Range(testCol & 1).Column

  Application.ScreenUpdating = False

  For Each anyTestCell In testRange

    'assume not a match, and to clean up anything

    'that was made red before but should not be now

    With anyTestCell.Offset(0, offset2RedCol)

      .Font.Bold = False

      .Font.ColorIndex = xlAutomatic

      If UCase(Trim(anyTestCell)) = keyPhrase Then

        .Font.Bold = True

        .Font.Color = vbRed

      End If

    End With

  Next

  Set testRange = Nothing ' good housekeeping

End Sub