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

spidaman

Board Regular
Joined
Jul 26, 2015
Messages
116
Office Version
  1. 365
Platform
  1. Windows
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:

Code:
    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
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Try
Code:
set foundCell20 = titRng.FindNext[COLOR=#ff0000](foundCell20)[/COLOR]
 
Upvote 0
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.
 
Upvote 0
You cannot use Findnext when using replace as well.
Try
Code:
   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
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
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:


Code:
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....
 
Upvote 0
As this is now a completely different question, you will need to start a new thread
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top