Conditional Replace with Find for one or another word string in a given cell

CalJake

New Member
Joined
Jul 13, 2020
Messages
2
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
So the code I have basically does what I want it to do: I have hundreds of Excel files I need to modify at a time repeatedly. If a specific cell ("B1") has the word string "draw" in it, nothing is to happen. If the cell doesn't have the word string "draw", the word "tank" is to be inserted before the word "prep" in the cell. The macro runs through all the files in a given folder, changes the format, outputs to a new folder, etc. This all works beautifully. But on occasion, the cell may contain the word string "pool" instead of "draw". In that case, I don't want to change the cell contents at all. So basically, if "pool" or "draw" is in the cell, do nothing. If they're both not present, add "Tank" before the word string "prep" in the cell. Here's the code I have:

VBA Code:
Sub SIS_ALIMS()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = "C:\Processed data"
strExtension = Dir(MyDir & "\*.xls")
While strExtension <> vbNullString
Set wbOpen = Workbooks.Open(MyDir & "\" & strExtension)
With wbOpen

Set rgFound = Range("B1").Find("draw", MatchCase:=False)

If rgFound Is Nothing Then

Range("B1").replace What:="prep", Replacement:="Tank prep"

Else

End If

Dim SaveName As String
    SaveName = ActiveSheet.Range("B8").Text
    ActiveWorkbook.SaveAs fileName:="C:\Processed data\ALIMS data\" & _
    SaveName & ".txt"

.Close SaveChanges:=False

End With
strExtension = Dir
Wend

Application.ScreenUpdating = True

End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
1,060
Office Version
  1. 365
  2. 2007
Platform
  1. Windows
Hi there. This should do it (untested):
VBA Code:
Sub SIS_ALIMS()

Dim wbOpen As Workbook
Dim MyDir As String
MyDir = "C:\Processed data"
strExtension = Dir(MyDir & "\*.xls")
While strExtension <> vbNullString
Set wbOpen = Workbooks.Open(MyDir & "\" & strExtension)
With wbOpen

Set rgFound = Range("B1").Find("draw", MatchCase:=False)
Set rgFound2 = Range("B1").Find("pool", MatchCase:=False)

If rgFound Is Nothing and  rgFound2 Is Nothing Then

Range("B1").replace What:="prep", Replacement:="Tank prep"

Else

End If

Dim SaveName As String
    SaveName = ActiveSheet.Range("B8").Text
    ActiveWorkbook.SaveAs fileName:="C:\Processed data\ALIMS data\" & _
    SaveName & ".txt"

.Close SaveChanges:=False

End With
strExtension = Dir
Wend

Application.ScreenUpdating = True

End Sub
 

Forum statistics

Threads
1,182,032
Messages
5,933,354
Members
436,889
Latest member
vamsi nandan

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
Top