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

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
1,056
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,148,334
Messages
5,746,162
Members
423,997
Latest member
moofish87

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