Solved Currency format in VBA

July 14, 2016 at 18:21:22
Specs: Windows 7
I created a macro that i pieced together different parts of code on the web to create what I needed to do and I honestly can't say i fully understand it. I have everything working except that the output from b2 onto the email has to be either currency with no decimals or comma with no decimals. I added a ' to the part that I tried using the numberformat feature because it did not work.

Here is the code I currently have, the part that isn't working is
ActiveSheet.Range("A2") & " " & ActiveSheet.Range("B2") ' .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

Sub Pipeline_EmailBranchNetRegs()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
End If
ActiveSheet.Range("$a$6:$AQ$1000").AutoFilter Field:=34, Criteria1:="<>Pre-Approval"
ActiveSheet.Range("$A$6:$AQ$1000").AutoFilter Field:=31, Criteria1:=Range("H4")
Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
End With
Signature = OutMail.HTMLBody
strbody = "Here is your Net Reg Pipeline:" & "<br />" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("B1") & "<br />" & ActiveSheet.Range("A2") & " " & ActiveSheet.Range("B2") ' .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

With OutMail
'.to = ActiveSheet.Range("F4")
.Subject = ActiveSheet.Range("H4") & " " & "Net Reg Pipeline"
.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
End With

On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

message edited by mecerrato

See More: Currency format in VBA

Reply ↓  Report •

July 15, 2016 at 04:56:07
First, a posting tip:

Please click on the blue line at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. The How-To will explain the use of the pre tags.


Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Reply ↓  Report •

July 15, 2016 at 07:52:27
✔ Best Answer
The best I could come with is the addition of a currency symbol to the string:

strbody = _
   "Here is your Net Reg Pipeline:" & "<br />" & "$" & _
      ActiveSheet.Range("A1") & " " & "$" & _
      ActiveSheet.Range("B1") & "<br />" & "$" & _
      ActiveSheet.Range("A2") & " " & "$" & _

The problem is that you are assigning the values in the cells to a text string within VBA. Text strings have no formatting, they are just a series of characters.

Even if you tried to directly transfer the formatted cell to the email via the .HTMLBody instruction (without building the text string first), all you would get is the value of the cell, not the associated formatting. That's because, once again, the .HTMLBody instruction simply produces a text string.

Unless I'm mistaken, the only way to format the negative numbers Red in the email would be to do that within Outlook, either manually or with an Outlook VBA macro.

I'm not well versed in Outlook VBA, so at this point I couldn't tell you what code you would use to find negative numbers in the email and format them as Red. If they were in a table, you might be able to format the table cells just like you do in Excel via an Outlook macro, but in your case, you are simply placing a text string in the body. In other words, just a bunch of ASCII characters.

In Excel VBA, you could manually format a "negative number" embedded in a text string Red by searching the text string until you found the negative sign, then continue searching until you found the trailing space and then formatting the characters in between as Red.

That sounds like a very cumbersome method to use within the body of an email, but it might be possible.

Good luck!

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03

Reply ↓  Report •

Related Solutions

Ask Question