G
Greg
Hi,
Several months ago Dave Lett and Bruce Brown and I worked
on a macro to convert raw numbers in a table to currency
format. Well actually Dava and Bruce worked and I learned.
I was wondering if anyone can have a look at this code and
see if there is a way to a. work out a small bug, and b.
refine it to act only on selected cells.
a. The small bug appears when there is a single non-
numerical character in the cell. This character is not
marked as non-numerical. I know the reason for this is
the line
If oRng.Characters.Count = 1 Then GoTo EndSmallLoop
Unfortunately if the Count is set to = 0 then the message
box alerts on all the empty cells as well. I can't find a
way to ignore empty cells while alerting on single non-
numerical characters.
b. The other issue is if you run this macro it converts
all numbers. If you have a table with ProductID,
Nomenclature, Unit Cost, Quantity Ordered, Total Cost,
etc. the macro converts all pure numerical numbers i.e. if
the quantity orderd is 6 it changes to $6.00. I would
like to find a way to make the macro act only on cells
physcially selected (highlighted) with the mouse or cursor.
Any help is appreciated. I will not be able to check back
here probably until Monday so don't think I am ignoring
your offer of assistance.
Sub ConvertRawNumbersToCurrencyFormat()
If Not Selection.Information(wdWithInTable) Then
MsgBox "Cursor must be in a table.", , "Quitting"
End
Else
Selection.MoveRight wdCharacter
End If
Dim oCl As Cell
Dim oRng As Range
Dim Rw As Row
Dim R As Range
Dim TableNo As Integer
Set R = Selection.Range
R.Start = ActiveDocument.Range.Start
TableNo = R.Tables.Count
For Each Rw In ActiveDocument.Tables(TableNo).Rows
If Rw.Index = 1 Then GoTo EndBigLoop
For Each oCl In Rw.Cells
Set oRng = oCl.Range
With oRng
.MoveEnd Unit:=wdCharacter, Count:=-1
If IsNumeric(oRng) Then
.Text = FormatCurrency _
(Expression:=.Text, _
NumDigitsAfterDecimal:=2, _
IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
End If
If oRng.Characters.Count = 1 Then GoTo
EndSmallLoop
On Error GoTo EndSmallLoop
' CATCH ERRORS HERE
If InStr(oRng.Text, "$") = False Then
oRng.Font.Color = wdColorRed
oRng.Select
MsgBox "Cell content is not
numerical.", , "Error"
Selection.Collapse wdCollapseEnd
End If
EndSmallLoop:
End With
Next
EndBigLoop:
Next
End Sub
Several months ago Dave Lett and Bruce Brown and I worked
on a macro to convert raw numbers in a table to currency
format. Well actually Dava and Bruce worked and I learned.
I was wondering if anyone can have a look at this code and
see if there is a way to a. work out a small bug, and b.
refine it to act only on selected cells.
a. The small bug appears when there is a single non-
numerical character in the cell. This character is not
marked as non-numerical. I know the reason for this is
the line
If oRng.Characters.Count = 1 Then GoTo EndSmallLoop
Unfortunately if the Count is set to = 0 then the message
box alerts on all the empty cells as well. I can't find a
way to ignore empty cells while alerting on single non-
numerical characters.
b. The other issue is if you run this macro it converts
all numbers. If you have a table with ProductID,
Nomenclature, Unit Cost, Quantity Ordered, Total Cost,
etc. the macro converts all pure numerical numbers i.e. if
the quantity orderd is 6 it changes to $6.00. I would
like to find a way to make the macro act only on cells
physcially selected (highlighted) with the mouse or cursor.
Any help is appreciated. I will not be able to check back
here probably until Monday so don't think I am ignoring
your offer of assistance.
Sub ConvertRawNumbersToCurrencyFormat()
If Not Selection.Information(wdWithInTable) Then
MsgBox "Cursor must be in a table.", , "Quitting"
End
Else
Selection.MoveRight wdCharacter
End If
Dim oCl As Cell
Dim oRng As Range
Dim Rw As Row
Dim R As Range
Dim TableNo As Integer
Set R = Selection.Range
R.Start = ActiveDocument.Range.Start
TableNo = R.Tables.Count
For Each Rw In ActiveDocument.Tables(TableNo).Rows
If Rw.Index = 1 Then GoTo EndBigLoop
For Each oCl In Rw.Cells
Set oRng = oCl.Range
With oRng
.MoveEnd Unit:=wdCharacter, Count:=-1
If IsNumeric(oRng) Then
.Text = FormatCurrency _
(Expression:=.Text, _
NumDigitsAfterDecimal:=2, _
IncludeLeadingDigit:=vbTrue, _
UseParensForNegativeNumbers:=vbTrue)
End If
If oRng.Characters.Count = 1 Then GoTo
EndSmallLoop
On Error GoTo EndSmallLoop
' CATCH ERRORS HERE
If InStr(oRng.Text, "$") = False Then
oRng.Font.Color = wdColorRed
oRng.Select
MsgBox "Cell content is not
numerical.", , "Error"
Selection.Collapse wdCollapseEnd
End If
EndSmallLoop:
End With
Next
EndBigLoop:
Next
End Sub