VBA Replace From Code to Range

[swaggerbox]

I have code below that reformats a certain string. I would like to transfer the replace parameters from the code to the range (Sheet2) so it would be easier for me to add the parameter instead of editing it in the code. Column A in Sheet2 are the words to replace while Column B in Sheet2 are the replacement terms. See attached workbook.

Could anyone lend me a helping hand?



Sub ProcessMar()
Dim myString As String


myString = ActiveSheet.TextBox1


myString = Replace(myString, " is a ", "=")
myString = Replace(myString, " is ", "=")
myString = Replace(myString, " to ", "-")
myString = Replace(myString, "selected from the group consisting of", "including")
myString = Replace(myString, "; ", "#")
myString = Replace(myString, "R1", "R_1")
myString = Replace(myString, "R2", "R_2")
myString = Replace(myString, "R3", "R_3")
myString = Replace(myString, "R4", "R_4")
myString = Replace(myString, "R5", "R_5")
myString = Replace(myString, "R6", "R_6")
myString = Replace(myString, "R7", "R_7")
myString = Replace(myString, "R8", "R_8")
myString = Replace(myString, "R9", "R_9")
myString = Replace(myString, "NO2", "NO_2")
myString = Replace(myString, "CH2", "CH_2")
myString = Replace(myString, "CH3", "CH_3")
myString = Replace(myString, ", and", "#")
myString = Replace(myString, "; and", "#")
myString = Replace(myString, "selected from one or more of ", "")
myString = Replace(myString, "hydrogen", "H")
myString = Replace(myString, "cyano", "CN")
myString = Replace(myString, "nitro", "NO_2")
myString = Replace(myString, "hydroxy", "OH")
myString = Replace(myString, "mercapto", "SH")
myString = Replace(myString, "methoxy", "OMe")
myString = Replace(myString, "trifluoromethyl", "CF3")
myString = Replace(myString, "trifluoromethoxy", "OCF3")
myString = Replace(myString, " are each independently including ", "=")
myString = Replace(myString, "halogen", "halo")
myString = Replace(myString, ":", "")
myString = Replace(myString, "#and ", "and#")
myString = "<MAR>" & myString & "</MAR>"


Dim lasPos As Integer
lasPos = InStrRev(myString, "#")
leftString = Left(myString, lasPos - 1)
leftString = leftString & "; and#"
rightString = Mid(myString, lasPos + 1, Len(myString))
myString = leftString & " " & rightString
myString = Replace(myString, "# ", "#")
ActiveSheet.TextBox2 = myString


End Sub

[paulked]

Try:



Sub ked()
Dim i&, myStr$, lasPos&, leftString$, rightString$
myStr = ActiveSheet.TextBox1
With Sheet2
For i = 1 To .Cells(.Rows.Count, 1).End(3).Row
myStr = Replace(myStr, .Cells(i, 1), .Cells(i, 2))
Next
End With
myStr = "<MAR>" & myStr & "</MAR>"
lasPos = InStrRev(myStr, "#")
leftString = Left(myStr, lasPos - 1)
leftString = leftString & "; and#"
rightString = Mid(myStr, lasPos + 1, Len(myStr))
myStr = leftString & " " & rightString
myStr = Replace(myStr, "# ", "#")
ActiveSheet.TextBox2 = myStr
End Sub

[swaggerbox]

Great! Thanks again Paulked!

[paulked]

:thumb

[snb]

I'd prefer:


Private Sub CommandButton1_Click()
sn = Sheet2.Cells(1).CurrentRegion

With Sheet1
.TextBox2 = "<MAR>" & .TextBox1 & "</MAR>"

For j = 1 To UBound(sn)
.TextBox2 = Replace(.TextBox2, sn(j, 1), sn(j, 2))
Next
.TextBox2 = Replace(Replace(.TextBox2, "#", "; and #"), "; and #", "#", , 1)
End With
End Sub

NB. Put the code in the macromodule it belongs to: sheet1.
Avoid worksheet interaction (reading / writing) as much as possible: use Arrays (like sn) to do this.

[snb]

I'd prefer:


Private Sub CommandButton1_Click()
sn = Sheet2.Cells(1).CurrentRegion

With Sheet1
.TextBox2 = "<MAR>" & .TextBox1 & "</MAR>"

For j = 1 To UBound(sn)
.TextBox2 = Replace(.TextBox2, sn(j, 1), sn(j, 2))
Next
.TextBox2 = Replace(Replace(.TextBox2, "#", "; and #"), "; and #", "#", , 1)
End With
End Sub

NB. Put the code in the macromodule it belongs to: sheet1.
Avoid worksheet interaction (reading / writing) as much as possible: use Arrays (like sn) to do this.

[paulked]

That's neat :thumb

[swaggerbox]

very neat indeed. thanks snb