Regular expressions in Excel?

[a]

Hi,

Monthly I have to convert comments from a local currency sheet to a US
dollar sheet in an excel file. In the comments the local currency is
often expressed. I need the value to be in US dollars when it appears
on the US dollar sheet. Is there a way to search the text to find the
local currency amounts and use a variable to convert that to US dollars.

Thanks in advance for any help that you can provide. I'm not betting
that I will get many answers to this one . . .

Regards,
Anita

 

[Markus Scheible]

Hi Anita,

how many different currencies can be used within the local
sheets? If there are just a few possibilities, you can
search for them with the Find method... but that won't
make sense if there may be more than a few of them...

Like:

If Range("commentrange").Find(what:="Yen") Is Not Nothing
Then

..
..

Else

End If


HTH

Best

Markus

 

[Tushar Mehta]

Yes, it is possible to use regular expressions within XL. For one
implementation see http://www.tmehta.com/regexp/ specifically the
links:

Adding the necessary code to an Excel workbook
http://www.tmehta.com/regexp/add_code.htm

Using the functions
http://www.tmehta.com/regexp/using_functions.htm

and
Examples of solving problems
http://www.tmehta.com/regexp/examples.htm

While not relevant to how one would use regexps in XL, do note that the
examples page does have errors in some of the patterns used in the
page.

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Guest]

You could try something like this. It is very basic at the moment with no
error handling and only set up to work on the activecell. It also assumes
that you will have no more than 31 values in the one text string.

Sub ChangeCurr()

Dim isSpace, isCurr, startNo As Integer
Dim textLength, currLength As Integer
Dim i, counter As Integer
Dim myText As String
Dim myValue(30) As Double 'assumes < 31 values in text
Dim myStarts, mySpaces As Integer
Dim msg As String

Dim oldCurr, newCurr As String
Dim convertCurr As Double

msg = "Enter Currency Code to be" & Chr(13)
msg = msg & "replaced e.g. AUD."
oldCurr = InputBox(msg)
msg = "Enter New Currency Code" & Chr(13)
msg = msg & "e.g. US$."
newCurr = InputBox(msg)

msg = "Enter conversion factor" & Chr(13)
msg = msg & "e.g. 1.2"
convertCurr = InputBox(msg)
currLength = Len(oldCurr)

myText = ActiveCell.Value
textLength = Len(myText)

startNo = 1
isHere = 1
isCurr = 1
i = 0
Do While isCurr > 0
isCurr = InStr(startNo, myText, oldCurr)
isSpace = InStr(InStr(startNo, myText _
, oldCurr) + 1, myText, " ")
If isCurr > 0 Then
myStarts = isCurr
mySpaces = isSpace
If isSpace > 0 Then
myValue(i) = Mid(myText, isCurr + currLength _
, isSpace - (isCurr + (currLength - 1)))
Else
myValue(i) = Right(myText, textLength - _
(isCurr + (currLength - 1)))
End If
startNo = isCurr + 1
i = i + 1
End If
Loop


For counter = i To 1 Step -1
ActiveCell.Replace What:="" & oldCurr & myValue(counter - 1) _
, Replacement:="" & newCurr _
& Round(myValue(counter - 1) * convertCurr, 2)
Next counter

End Sub

Regards
Rowan

 

[Guest]

PS works to change the text in a single cell from e.g.

"This is my text with AUD50.37 and then also AUD60.12 and also AUD70.25"

to

"This is my text with US$60.44 and then also US$72.14 and also US$84.3"

 

[Anita]

Rowan,

Thank you so much for the code. I'm not familiar with some of the
syntax and so I am unable to make it work unless I put the currency
description in front of the currency amount. All of the comments that I
receive have the currency description following the currency amount.

I've been able to figure out the instr function, but not the second
nested one. I'm not sure why I'm coming up with the number that I come
up with.

Would you be able to help me understand that nested instr? I think that
this is what is tripping me up.

Again, thank you so much for the wonderful code!!

Anita

 

[Guest]

Anita

The nested instring finds the first space after finding the currency.

isSpace = InStr(InStr(startNo, myText , oldCurr) + 1, myText, " ")

The nested portion finds the position of the Currency and moves one
character right from there as the start position for the outer instring. Why
I didn't just add one to the isCurr variable set in the line above and use
that I have no idea - I was in a bit of a hurry.

Anyway, I have had a little more time to look at it now and having the
currency after the value actually makes the vba a little easier using the
instrev function.

This new macro is very similar to the old one but once finding the currency
it uses the instrrev function to move back to the previous space and from
there picks up the value. Again these values are placed in an array (which I
have also tidied up so that it doesn't assume only 30 repetitions).

In the final loop each value from the array is used in a find and replace
exercise.

I hope this makes more sense this time.

Regards
Rowan - code follows

Sub ChangeCurrnew()

Dim isSpace, isCurr, startNo As Integer
Dim i As Integer
Dim myText As String
Dim myValues() As Double
Dim myVal As Variant
Dim msg As String

Dim oldCurr, newCurr As String
Dim convertCurr As Double

msg = "Enter Currency Code to be" & Chr(13)
msg = msg & "replaced e.g. AUD."
oldCurr = InputBox(msg)

msg = "Enter New Currency Code" & Chr(13)
msg = msg & "e.g. US$."
newCurr = InputBox(msg)

msg = "Enter conversion factor" & Chr(13)
msg = msg & "e.g. 1.2"
convertCurr = InputBox(msg)

myText = ActiveCell.Value

startNo = 1
isCurr = 1
i = 0
Do While isCurr > 0
isCurr = InStr(startNo, myText, oldCurr)
If isCurr > 0 Then
isSpace = InStrRev(myText, " ", isCurr)
ReDim Preserve myValues(i)
myValues(i) = Mid(myText, isSpace, isCurr - isSpace)
startNo = isCurr + 1
i = i + 1
End If
Loop


For Each myVal In myValues
ActiveCell.Replace What:="" & myVal & oldCurr _
, Replacement:="" & Round(myVal * convertCurr, 2) _
& newCurr, LookAt:=xlPart
Next

End Sub

 

[a]

Rowan,

Thank you so much for all of the help. Unfortunately, the code does not
work for me. Since I was getting type mismatch errors - I got rid of
the variable declarations. That stopped that problem.

Also, for some reason, the Values(i), in the watch window, returned
nothing. I tried some tweaking, but it just gave me weird values.

Does this code work for you? I'll give you an example of the text that
I'm trying to translate into US$'s:

"car allowance will be 500 yen over budget due to the two unexpected 250
yen payments that were not anticipated"

Would you have any idea why this code would not work? Tracking it in
the watch window always gets me hopeful - but then the final conversion
should happen and I either get a type mismatch, or it simply won't do
what is expected.

Again, thank you so much for all that you have put into this!

Best Regards,

 

[Guest]

Anita

We probably should have started out with some of your text - I was assuming
no space between the currency and value eg 500AUD. I have changed the code
very slightly to take into account your extra spaces and it seems to work
now.

Regards
Rowan

Sub ChangeCurrnew()

Dim isSpace, isCurr, startNo As Integer
Dim i As Integer
Dim myText As String
Dim myValues() As Double
Dim myVal As Variant
Dim msg As String

Dim oldCurr, newCurr As String
Dim convertCurr As Double

msg = "Enter Currency Code to be" & Chr(13)
msg = msg & "replaced e.g. AUD."
oldCurr = InputBox(msg)

msg = "Enter New Currency Code" & Chr(13)
msg = msg & "e.g. US$."
newCurr = InputBox(msg)

msg = "Enter conversion factor" & Chr(13)
msg = msg & "e.g. 1.2"
convertCurr = InputBox(msg)

myText = ActiveCell.Value

startNo = 1
isCurr = 1
i = 0
Do While isCurr > 0
isCurr = InStr(startNo, myText, oldCurr)
If isCurr > 0 Then
isSpace = InStrRev(myText, " ", isCurr - 2)
ReDim Preserve myValues(i)
myValues(i) = Mid(myText, isSpace, (isCurr - 1) - isSpace)
startNo = isCurr + 1
i = i + 1
End If
Loop


For Each myVal In myValues
ActiveCell.Replace What:="" & myVal & " " & oldCurr _
, Replacement:="" & Round(myVal * convertCurr, 2) _
& " " & newCurr, LookAt:=xlPart
Next

End Sub