Limiting Find and Replace Format Function in VBA

[BrandynBlaze]

Hi there!

I'm pretty new to VBA programming, but I built the Find and Replace function below that searches for the value in each row of the first column of sheet 5 and if it finds a match it replaces the format in sheet 5 to the cell in sheet 1.

It works currently, but I'd like to change it in a couple of ways and was hoping someone here would be able to help me.

First, I would like to be able to consider only the first 4 characters of the cell in sheet 1 for a match. This is because it's looking for a customer account number, and the digits after the first 4 are inconsequential but are resulting in false positives.

Secondly/alternatively, I would like to be able to change the font color in sheet one for only the characters that are a match. Currently if there is a match the entire text is changed to that font color, but I'd like to leave the non-matching piece black so we can see what was changed.

Sub FindAndReplace(Tofind)
      
    Dim cell As Range
    
    
    'With Worksheets("Sheet3")
    Sheet5.Activate
    
        For Each cell In Tofind
            'ToFind is the range of values to replace determined by ReplaceRange()
            
            cell.Select
            'MsgBox ActiveCell.Font.Color
            
            If Not Tofind.Cells.Find(cell.Value, , xlValues, xlPart, , , True) Is Nothing Then 'Double negative, if there is something in ToFind then...
                
 
                With Application.ReplaceFormat.Font
                    .Color = ActiveCell.Font.Color
                End With
                
                With Application.ReplaceFormat.Interior
                    .Color = ActiveCell.Interior.Color
                End With
            
                
                Sheet1.Cells.Replace _
                What:=cell.Value, Replacement:=cell.Value, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
       
            End If
        Next cell
    'End With
    Sheet1.Activate
    'Application.ScreenUpdating = False
    
End Sub