Find and Replace with cell Value

[lynxbci]

Hi,
I have multiple worksheets with cells, some of which contain formulas that link it to an outside data source. The formulas are not always starting with the same text. But always contain "cc.f" somehwere in the formula.

I have tried in vane to write a macro that looks at all cells to see if they contain "cc.f" anywhere and if they do replace the cell with its value. The issue with this code is that it replaces any cell with anything in it with the cell value.

This is the main part of the code i tried (if it helps)

For Each ws In ActiveWorkbook.Worksheets
     On Error Resume Next
     For Each c In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
           
     Set foundcog = c.Find(What:="cc.f", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
     :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
     False, SearchFormat:=False).Activate
                                      
     If UCase(TypeName(foundcog)) <> UCase("Nothing") Then
        ActiveCell.Replace What:="*", Replacement:=ActiveCell.Text, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
      End If
                    
      Cells.FindNext(After:=ActiveCell).Activate
                    
   Next
   On Error GoTo 0
Next ws

Please help me to solve this one

Thanks

 

[CharlesChuckieCharles]

Hi,
I have multiple worksheets with cells, some of which contain formulas that link it to an outside data source. The formulas are not always starting with the same text. But always contain "cc.f" somehwere in the formula.

I have tried in vane to write a macro that looks at all cells to see if they contain "cc.f" anywhere and if they do replace the cell with its value. The issue with this code is that it replaces any cell with anything in it with the cell value.

This is the main part of the code i tried (if it helps)

For Each ws In ActiveWorkbook.Worksheets
     On Error Resume Next
     For Each c In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
 
     Set foundcog = c.Find(What:="cc.f", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
     :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
     False, SearchFormat:=False).Activate
 
     If UCase(TypeName(foundcog)) <> UCase("Nothing") Then
        ActiveCell.Replace What:="*", Replacement:=ActiveCell.Text, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
      End If
 
      Cells.FindNext(After:=ActiveCell).Activate
 
   Next
   On Error GoTo 0
Next ws

Please help me to solve this one

Thanks

TRY THIS

Function clearit()
Dim c As Range
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
     On Error Resume Next
     For Each c In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
           
     If InStr(1, c.Formula, "CC.F") > 0 Then
        c.Value = c.Value
     End If
     
                            
     Next c
   On Error GoTo 0
Next ws
End Function

Mostly yours but less

 

[lynxbci]

Fantastic

Thansk so much, simple and effective.