Change currency format

[shekhu]

Hi, I got this macro from this forum itself. This is similar to what I need.
Actually, what this macro does is changes $1.00 to 1,00$ (I don't want this)

What I want is this format (just adds .00 to any number) $1 to $1.00
$50,000 to $50,000.00
or just any number 200 to $200.00


Sub ChangeFormat()
'Modified by David Sisson 11/27/10
'http://www.vbaexpress.com/forum/showthread.php?t=35160
'A quick macro scratch pad created by Greg Maxey
'http://www.vbaexpress.com/forum/showthread.php?p=230003
Dim oRng As Word.Range
Dim Ans$ 'as string
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "$[0-9.,]{1,}" 'Find the currency pattern
.MatchWildcards = True
While .Execute
With oRng.Duplicate.Find
oRng.Select
Ans$ = MsgBox(oRng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format")
If Ans$ = 6 Then
oRng = Replace(oRng, ",", " ")
oRng = Replace(oRng, ".", ",")
oRng = Right(oRng, Len(oRng) - 1) & "$"
oRng.Collapse wdCollapseEnd
End If
End With
Wend
End With
End Sub

[gmaxey]

Try:

Sub ApplyCurrencyFormatToDocumentNumbers()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[$0-9.,]{1,}"
.MatchWildcards = True
While .Execute
If oRng.Characters.First = "$" And Right(oRng.Text, 3) Like ".##" Then
oRng.Collapse wdCollapseEnd
Else
oRng.Select
If MsgBox(oRng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
oRng = FormatCurrency(Expression:=oRng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
oRng.Collapse wdCollapseEnd
End If
End If
Wend
End With
Selection.HomeKey
End Sub

[gmaxey]

Let me revise that slightly:

Sub ApplyCurrencyFormatToDocumentNumbers()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[$0-9.,]{1,}"
.MatchWildcards = True
While .Execute
If IsNumeric(oRng) Then
If oRng.Characters.First = "$" And Right(oRng.Text, 3) Like ".##" Then
oRng.Collapse wdCollapseEnd
Else
oRng.Select
If MsgBox(oRng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
oRng = FormatCurrency(Expression:=oRng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
oRng.Collapse wdCollapseEnd
End If
End If
End If
Wend
End With
Selection.HomeKey
End Sub

[shekhu]

Thanks a lot Greg, it works fine. :beerchug:

[shekhu]

Greg,

There is a small issue still. When we replace
ActiveDocument.Range
with
Selection.Range

The macro doesn't work for the selected portion only. Actually it starts at the selected portion but ends at the end of the document (means to the last number found up until the end of the document).

The fact is that i paste some text in a template and I need the macro should work on the pasted text only (that is selected) and not on the original text of the template.

Your effort is always appreciated.
Thanks, Sunil

[gmaxey]

Ok try the following:

Sub ApplyCurrencyFormatToDocumentNumbers()
Dim orng As Word.Range, oRngLimit As Word.Range
Dim bLimitSrch As Boolean
If Selection.Type <> wdSelectionIP Then
Set oRngLimit = Selection.Range
Set orng = Selection.Range
bLimitSrch = True
Else
Set orng = ActiveDocument.Range
bLimitSrch = False
End If
If IsNumeric(Selection.Text) Then
If MsgBox(orng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
orng = FormatCurrency(Expression:=orng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
orng.Collapse wdCollapseEnd
Exit Sub
End If
End If
With orng.Find
.Text = "[$0-9.,]{1,}"
.MatchWildcards = True
While .Execute
If bLimitSrch And Not orng.InRange(oRngLimit) Then Exit Sub
If IsNumeric(orng) Then
If orng.Characters.First = "$" And Right(orng.Text, 3) Like ".##" Then
orng.Collapse wdCollapseEnd
Else
orng.Select
If MsgBox(orng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
orng = FormatCurrency(Expression:=orng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
orng.Collapse wdCollapseEnd
End If
End If
End If
Wend
End With
Selection.HomeKey
End Sub

[gmaxey]

You may have noticed that I add code to deal with a case where the selection is a numeric value (say you select just one number e.g., 100)
The reason I did that is because the .Find method falls over if you try to find a value and the value is the same as the search range.

You can observe this if you select a small section of text and run the following two procedures:

Sub ScratchMacroI()
'A quick macro scratch pad created by Greg Maxey
Dim oRng As Word.Range
Set oRng = Selection.Range
With oRng.Find
.Text = Selection.Text
MsgBox .Execute
End With
End Sub
Sub ScratchMacroII()
'A quick macro scratch pad created by Greg Maxey
Dim oRng As Word.Range
Set oRng = Selection.Range
With oRng.Find
.Text = Left(Selection.Text, Len(Selection.Text) - 1)
MsgBox .Execute
End With
End Sub

[shekhu]

Greg, this is okay. It works well when selecting the text.

But, if somehow I am unable to select the text it gives a run-time error (see attachment). Is it possible if i forget to select the text it gives a message like "Please select the text."

[gmaxey]

Sorry about that. I meant for it to automatically process the entire document if the seleciton was the IP and didn't test adequately. Try:

Sub ApplyCurrencyFormatToDocumentNumbers()
Dim oRng As Word.Range, oRngLimit As Word.Range
Dim bLimitSrch As Boolean
If Selection.Type <> wdSelectionIP Then
Set oRngLimit = Selection.Range
Set oRng = Selection.Range
bLimitSrch = True
Else
Set oRng = ActiveDocument.Range
bLimitSrch = False
End If
If IsNumeric(Selection.Text) Then
If MsgBox(oRng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
oRng = FormatCurrency(Expression:=oRng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
oRng.Collapse wdCollapseEnd
Exit Sub
End If
End If
With oRng.Find
.Text = "[$0-9.,]{1,}"
.MatchWildcards = True
While .Execute
If bLimitSrch Then
If Not oRng.InRange(oRngLimit) Then Exit Sub
End If
If IsNumeric(oRng) Then
If oRng.Characters.First = "$" And Right(oRng.Text, 3) Like ".##" Then
oRng.Collapse wdCollapseEnd
Else
oRng.Select
If MsgBox(oRng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
oRng = FormatCurrency(Expression:=oRng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
oRng.Collapse wdCollapseEnd
End If
End If
End If
Wend
End With
Selection.HomeKey
End Sub

[shekhu]

Thanks a lot Greg, this is perfect. :thumb

[shekhu]

Hope this will help making this macro better.
http://www.codeguru.com/forum/showthread.php?t=505746

[gmaxey]

I thought it was already perfect. Or at least you did ;-). I must confess that I don't always spend a great deal of time trying to perfect the code I post here. If it works for you then I am satisfied.

[gmaxey]

Concerning the comment "...and the two nested Ifs (which, BTW, could also be written as a single IF with the two conditions And'ed):"

This is true only it the variable oRngLimit is set previously. In the code provided this variable is only set if there is some text selected. As written, combining the nested IFs would result in a RTE in conditions where no text were selected.

I don't really have an opinion on which is better 1) Set the variable when it really isn't needed just to be able to combine two IFs or 2) Use two IFs as I did.

Since I am now polishing the cannon ball, I suppose I would revise as follows:


Sub ApplyCurrencyFormatToDocumentNumbers()
Dim oRng As Word.Range, oRngLimit As Word.Range
Dim bLimitSrch As Boolean
If Selection.Type <> wdSelectionIP Then
bLimitSrch = True
Set oRng = Selection.Range
Set oRngLimit = Selection.Range
Else
bLimitSrch = False
Set oRng = ActiveDocument.Range
Set oRngLimit = ActiveDocument.Range
End If
If IsNumeric(Selection.Text) And Selection.Type <> wdSelectionIP Then
FormatSelectedNumber oRng
Exit Sub
End If
With oRng.Find
.Text = "[$0-9.,]{1,}"
.MatchWildcards = True
Do While .Execute
If bLimitSrch And Not oRng.InRange(oRngLimit) Then Exit Do
If IsNumeric(oRng) Then FormatSelectedNumber oRng
Loop
End With
Selection.HomeKey
End Sub

Sub FormatSelectedNumber(ByRef oTextRng As Word.Range)
If oTextRng.Characters.First = "$" And Right(oTextRng.Text, 3) Like ".##" Then
oTextRng.Collapse wdCollapseEnd
Else
oTextRng.Select
If MsgBox(oTextRng & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
oTextRng = FormatCurrency(Expression:=oTextRng, _
NumDigitsAfterDecimal:=2, IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
oTextRng.Collapse wdCollapseEnd
End If
End If
End Sub

[fumei]

" In the code provided this variable is only set if there is some text selected"

Why do you say that?
If Selection.Type <> wdSelectionIP Then
bLimitSrch = True
Set oRng = Selection.Range
Set oRngLimit = Selection.Range
Else
bLimitSrch = False
Set oRng = ActiveDocument.Range
Set oRngLimit = ActiveDocument.Range
End If

The very set of instructions sets oRngLimit, regardless of whether there is anything selected. If there is, that sets oRngLimit; if not, the variable becomes ActiveDocument.Range.

Oh..wait a second. You werer refering to the previously posted code. Ah. OK.

As for the variable versus two IF: there may be a marginally better case to be had for the variable, but I seriously doubt if it could be proven to actually be better.

Unless you have a 400 page document you want to test on, with lots and lots of conversions to be done. May be an interesting test though. Hmmmmmm.




OK. On a 217 page document, with 38,776 instances of numbers to be changed...

Time for BOTH versions: 1m 19s

No diifference.

That is a test removing any messagebox asking Yes or No. Obviously any user response is too variable for any testing. So ALL instances were actioned.

Maybe at a sub-sub-second level there is a difference, but for our purposes, there is no difference.