Recolor cells based on linking

[_anon_]

Hi there, I'm trying to create a macro to auto recolor cells based on some criteria:

• Blue for numbers
• Cyan for direct links from other worksheets
• Magenta for links to other workbooks

I've made the following code to all execute on a single sub, which is where the issue arises I think. Is there a way to combine this as a single shortcut?

Apologies for any messy code - first time learning this, and couldn't find an easy way to code up a "Find All".

Sub AutoRecolor()

 
' Change hardcode numbers
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
    With Selection.Font
        .Color = Blue
    End With
    
' Change sheets
    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range
    Dim myRange As Range, LastCell As Range
    
    'search term (other sheets)
    fnd = "!"
    
    Set myRange = ActiveSheet.UsedRange
    Set LastCell = myRange.Cells(myRange.Cells.Count)
    Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
    
    Set rng = FoundCell
    
    'Loop until cycled through all unique finds
      Do Until FoundCell Is Nothing
        'Find next cell with fnd value
          Set FoundCell = myRange.FindNext(after:=FoundCell)
        
        'Add found cell to rng range variable
          Set rng = Union(rng, FoundCell)
        
        'Test to see if cycled through to first found cell
          If FoundCell.Address = FirstFound Then Exit Do
          
      Loop
    
    'Change font to cyan
    rng.Font.Color = Cyan
      
' NOW FOR OTHER WORKBOOKS


    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range
    Dim myRange As Range, LastCell As Range
    
    'search term (other workbooks)
    fnd = ".xl"
    
    Set myRange = ActiveSheet.UsedRange
    Set LastCell = myRange.Cells(myRange.Cells.Count)
    Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
    
    Set rng = FoundCell
    
    'Loop until cycled through all unique finds
      Do Until FoundCell Is Nothing
        'Find next cell with fnd value
          Set FoundCell = myRange.FindNext(after:=FoundCell)
        
        'Add found cell to rng range variable
          Set rng = Union(rng, FoundCell)
        
        'Test to see if cycled through to first found cell
          If FoundCell.Address = FirstFound Then Exit Do
          
      Loop
    
    'Change font to magenta
      rng.Font.Color = Magenta
          


End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub anon()
   Dim cl As Range
   
   With ActiveSheet
      .UsedRange.SpecialCells(xlConstants, 1).Font.Color = vbBlue
      For Each cl In .UsedRange.SpecialCells(xlFormulas)
         If InStr(1, cl.Formula, "!") > 0 Then cl.Font.Color = vbCyan
         If InStr(1, cl.Formula, ".xl") > 0 Then cl.Font.Color = vbMagenta
      Next cl
   End With
End Sub

 

[_anon_]

Thank you very much for this - realized my loop was way more complicated than it needed to be. If I only wanted to change cells to Cyan that were in a different sheet and were numbers, how would I approach this?

Would the

UsedRange.SpecialCells(xlConstants, 1)

be an appropriate component of an And condition?

 

[_anon_]

Nevermind - figured it out! Updated for anyone else who wants this in the future.

Sub recolor()

   Dim cl As Range
   
   With ActiveSheet
      .UsedRange.SpecialCells(xlConstants, 1).Font.Color = vbBlue
      For Each cl In .UsedRange.SpecialCells(xlFormulas)
         If InStr(1, cl.formula, "!") > 0 And IsNumeric(cl) Then cl.Font.Color = vbCyan
         If InStr(1, cl.formula, ".xl") > 0 And IsNumeric(cl) Then cl.Font.Color = vbMagenta
      Next cl
   End With
End Sub

 

[Fluff]

Glad you sorted it & thanks for the feedback