Identify Matching Strings in Header Row then Replace characters in those Columns

[spidaman]

Can anyone help with this please:

I wish to Find any cells in Rows(1) with the value "To Attribs". Then for each column with this heading, for each cell, to replace specific strings with "" (i.e. delete the strings).

In case it is relevant, some of the cells in the columns with the "To Attribs" heading are empty.

This is the code I have so far, but it only acts on one of the columns with "To Attribs" in Rows(1) and the Loop doesn't seem to be working:

    Dim titRng As Range
    Dim TargetStr20 As String

    Set titRng = ActiveWorkbook.Sheets(1).Rows(1)

    TargetStr20 = "To Attribs"
    
    Set foundCell20 = titRng.Find(what:=TargetStr20, LookIn:=xlValues, _
    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
    MatchCase:=True, SearchFormat:=False)


    k = ""


    If Not foundCell20 Is Nothing Then


            Do Until foundCell20 Is Nothing
                                
                Set ToRng20 = Intersect(foundCell20.EntireColumn, ws1.UsedRange)
                    
                ToRng20.Replace what:=MyString1, replacement:=k, lookat:=xlPart, MatchCase:=True
                ToRng20.Replace what:=MyString3, replacement:=k, lookat:=xlPart, MatchCase:=True
                ToRng20.Replace what:=MyString4, replacement:=k, lookat:=xlPart, MatchCase:=True
                    
                foundCell20.Value = "Replaced"
                    
                Set foundCell20 = titRng.FindNext
            
            Loop
                    
    Else


    End If

 

[Fluff]

Try

set foundCell20 = titRng.FindNext[COLOR=#ff0000](foundCell20)[/COLOR]

 

[spidaman]

Thanks for your help again Fluff. I should have spotted that!
Unfortunately still not working on all columns with "To Attribs" in the header.
There are several empty cells in Row 1 between populated cells in case that makes a difference.

 

[Fluff]

You cannot use Findnext when using replace as well.
Try

   Dim titRng As Range
   Dim TargetStr20 As String
   Dim Cnt As Long, i As Long

   Set titRng = ActiveWorkbook.Sheets(1).Rows(1)

   TargetStr20 = "To Attribs"
   Cnt = Application.CountIf(titRng, TargetStr20)
   
   K = ""

   For i = 1 To Cnt
      Set foundcell20 = titRng.Find(TargetStr20, , xlValues, xlWhole, xlByColumns, xlNext, True, , False)
      If Not foundcell20 Is Nothing Then
         foundcell20.EntireColumn.Replace what:=MyString1, replacement:=K, lookat:=xlPart, MatchCase:=True
         foundcell20.EntireColumn.Replace what:=mystring3, replacement:=K, lookat:=xlPart, MatchCase:=True
         foundcell20.EntireColumn.Replace what:=MyString4, replacement:=K, lookat:=xlPart, MatchCase:=True
         foundcell20.Value = "Replaced"
      End If
   Next i

 

[spidaman]

You cannot use Findnext when using replace as well

That's useful to know, thanks.

Your code worked like a dream.

Much appreciated Fluff

 

[Fluff]

You're welcome & thanks for the feedback

 

[spidaman]

Hi Fluff

I have a tricky bit of code I am stuck with that I was hoping you might be able to help out with. It is for the same procedure as the above.

I need to Find all columns that have a specific string in the header in Row 1 much like before, then for each row from all those columns, if the cell is not empty, merge the contents into a single string for each corresponding row in another column.
The range that is to be populated with the concatenated string is ToFin here:

TargetStr22 = "Other String"


Set foundCell22 = titRng.Find(what:=TargetStr22, LookIn:=xlValues, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=True, SearchFormat:=False)


foundCell22.EntireColumn.Insert
Set ToFin = Intersect(foundCell22.Offset(0, -1).EntireColumn, ws1.UsedRange)

For Each FinAtCel In ToFin

'  join values from each column where the header in Row 1 is "Attribs Replaced" with a " / " between each joined cell
' can I use your Application.Countif method for this? 

Next FinAtCel

Any chance you can offer a solution for this pls?
I have had a good crack at it but is still above my level....

 

[Fluff]

As this is now a completely different question, you will need to start a new thread