excelvbacopy-paste

Blue font color when pasting to <> sheet, black when pasting to current sheet


I have a range copied in memory.

Next I need to Paste Link it with the rows absolute and columns relative.

I always select manually the Destination Range

  1. if Destination Range is on a different worksheet font color shall be blue
  2. if Destination Range is on same worksheet font color shall be green

The macro bellow sorts out the Paste Link, conversion of formula to rows abs refs and font blue.

I do not know how to tell it to compare the source worksheet with the destination worksheet and apply font color accordingly.

    Sub PasteLink_Array_Blue_Green()
    
        Dim rng As Range
        Dim arr As Variant
        Dim i As Long, j As Long
        
                ' Paste the links into the currently active sheet
        activeSheet.Paste Link:=True

                ' Preserve source formatting
        rng.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
                ' Store the selection in a range object
           

       Set rng = Selection

                ' Convert the formulas to an array
        arr = rng.formula

                ' Loop through the array and convert each formula
        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 2) To UBound(arr, 2)
                If IsArray(arr(i, j)) Then
                    arr(i, j) = Application.ConvertFormula(arr(i, j)(1, 1), xlA1, xlA1, xlAbsRowRelColumn)
                Else
                    arr(i, j) = Application.ConvertFormula(arr(i, j), xlA1, xlA1, xlAbsRowRelColumn)
                End If
            Next j
        Next i

                ' Apply the converted formulas back to the range

        rng.formula = arr

                ' Change the font color to blue   
        rng.Font.Color = RGB(0, 0, 255)
    
    End Sub

Your help would be appreciated.


Solution

  • Microsoft documentation:

    InStr function

    ' Change the font color to blue
        If InStr(rng.Cells(1).Formula, "!") > 0 Then
            rng.Font.Color = RGB(0, 0, 255)
        Else
            rng.Font.Color = RGB(0, 255, 0)
        End If