Converting Numbers To Words Part I

I overheard two people talking, one of whom was showing his intellectual prowess using that puzzle whose answer is always ‘four’. I don’t remember the specifics of the game, but you count the letters of an integer, do some basic math, and you always end up with ‘four’ because the word ‘four’ has that many letters in it. I get how it works, but I thought there’s surely another number with that property. Off to VBA to find out.

There’s not. But let me back up a bit. I searched the vast DDoE archives to find my Numbers-to-Words code. I’ve already written this code right? Apparently not. A broader search showed plenty of hits and, I’m sure, code, but I didn’t click any of the links. I’ve been hankering to write some test-first code and this seemed like a good candidate. I didn’t want to read anybody else’s code so it wouldn’t influence my test-first experience.

I’m going to document my test-first methodology in a series of posts. This is not test driven development (TDD), but borrows some of the principles from that. Basically, I write a test, watch it fail, then write enough code to make it pass. I refactor the code as necessary. If you are interested in TDD in Excel and VBA, search for xlUnit on Mike Woodhouse’s blog.

On to test 1! The idea is to write a function that returns a string that represents the English words of the argument. The procedure header should look like this:

Function NumbersToWords(ByVal dNumbers As Double) As String

First, write a test.

Sub TEST_Singles()

Debug.Assert NumbersToWords(0) = "zero"
Debug.Assert NumbersToWords(1) = "one"
Debug.Assert NumbersToWords(7) = "seven"
Debug.Assert NumbersToWords(19) = "nineteen"

End Sub

I know that once I hit 20 a pattern will start emerging, so I’m going to start by testing up to 19. Now I have to write enough code to make this pass. That’s seems pretty easy.

Function NumbersToWords(ByVal dNumbers As Double) As String

Dim vaSingles As Variant

vaSingles = Split("zero,one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen", ",")

NumbersToWords = vaSingles(dNumbers)

End Function

When I run that test, it passes. I put all the words for zero to 19 in an array, then read the array. What could be easier? For my tests, I choose the two edge cases (0 and 19) and a couple in the middle. It’s not very rigorous, but what the heck. One of the benefits of a test-first approach is that you’re biting off a bigger problem in smaller chunks. No single code revision is particularly difficult, but when put together can be complex. The refactoring part will be the interesting part. I assume it will be apparent when it’s time to refactor (as it is in examples I’ve seen) but I’ve never done it before, so we’ll see.

Next time, I’ll test some ‘tens’.

Avoiding Date Conversion When Pasting an HTML Table

From Get Data From a Website…, MD comments:

However, the info in the table I copy is formatted ## / ## whereby # represents a number.
So when it tries to paste 10 / 10 in the worksheet for example, it auto-changes to 10/okt in my sheet.

This is a common problem that’s hard to solve. There’s no setting I can find in Excel that tells it to stop converting things that look like dates into dates. Since I’m reading in the data and putting it in the clipboard, I can just message the data before I do it. That’s not so easy when you just want to copy and paste, but if you’re using code, you may find the technique useful.

In the above linked post, I automated Internet Explorer to login to a website. I don’t automate Internet Explorer any more, preferring XML instead. But it doesn’t matter which you use. It all ends up in an HTMLDocument, so it’s the same from there. Also, this example doesn’t log into a webpage. It uses Contextures’ Sample Data.

Sub GetTableNoDateConversion()

Dim xHttp As MSXML2.XMLHTTP
Dim hDoc As MSHTML.HTMLDocument
Dim hTable As MSHTML.HTMLTable
Dim hCell As MSHTML.HTMLTableCell
Dim doClip As MSForms.DataObject

'Get the webpage
Set xHttp = New MSXML2.XMLHTTP
xHttp.Open "GET", "http://www.contextures.com/xlSampleData01.html"
xHttp.send

'Wait for it to load
Do: DoEvents: Loop Until xHttp.readyState = 4

'Put it in a document
Set hDoc = New MSHTML.HTMLDocument
hDoc.body.innerHTML = xHttp.responseText

'Find the third table
Set hTable = hDoc.getElementsByTagName("table").Item(2)

'Fix anything that looks like a date
For Each hCell In hTable.Cells
If IsDate(hCell.innerText) Then
hCell.innerText = "'" & hCell.innerText
End If
Next hCell

'put it in the clipboard
Set doClip = New MSForms.DataObject
doClip.SetText "" & hTable.outerHTML & ""
doClip.PutInClipboard

'paste it to the sheet
Sheet1.Select
Sheet1.Range("A1").Select
Sheet1.PasteSpecial "Unicode Text"

'Make the leading apostrophes go away
Sheet1.Range("A1").CurrentRegion.Value = Sheet1.Range("A1").CurrentRegion.Value

End Sub

Once I get the table into an HTMLTable object, I loop through all the HTMLTableCells to see if any of them looks like a date. If so, I put an apostrophe in front of it. The apostrophe is the Excel way to say “No matter what I type next, assume it’s text”. Except when you’re pasting special as Unicode Text. In that case, it doesn’t hide the apostrophe like it should. So the last line of the code is the equivalent of pressing F2 and Enter all the say down the column and forcing Excel to reevaluate its decision to ignore that apostrophe.

Find Your Dropbox Folder in VBA

Here’s a function to get the location of the Dropbox folder:

Public Function DropBox() As String

Dim DropboxHostFile As String
Dim DropboxHostFileNumber As Long
Dim Base64EncodedPath As String
Dim TempXMLDocument As MSXML2.DOMDocument60
Dim Base64XMLNode As MSXML2.IXMLDOMElement

DropboxHostFile = Environ("appdata") & "\Dropbox\host.db"
DropboxHostFileNumber = FreeFile

Open DropboxHostFile For Input As DropboxHostFileNumber
Base64EncodedPath = Input$(LOF(DropboxHostFileNumber), DropboxHostFileNumber)
Close DropboxHostFileNumber

Set TempXMLDocument = New MSXML2.DOMDocument60
Set Base64XMLNode = TempXMLDocument.createElement("b64")
Base64XMLNode.DataType = "bin.base64"
Base64XMLNode.Text = Split(Base64EncodedPath, vbLf)(1)

DropBox = StrConv(Base64XMLNode.nodeTypedValue, vbUnicode)

End Function

According to Reinaldo there is a host.db file in the Roaming directory that stores this information. The Environ("appdata") function returns the Roaming directory in Win7. I open host.db and read in the text. Then I create a new XML document, thanks to Tim Hastings, to write in the Base64 text and read out the byte data that is converted to Unicode. There’s two lines in my host.db file, so I split on vbLf and only use the second line.

Here’s what it would look like if I wrote this function and didn’t want to poke my eyes out afterward.

Public Function DropBox() As String

Dim sFile As String
Dim lFile As Long
Dim sPath As String
Dim xDoc As MSXML2.DOMDocument60
Dim xNode As MSXML2.IXMLDOMElement

sFile = Environ("appdata") & "\Dropbox\host.db"
lFile = FreeFile

Open sFile For Input As lFile
sPath = Input$(LOF(lFile), lFile)
Close lFile

Set xDoc = New MSXML2.DOMDocument60
Set xNode = xDoc.createElement("b64")
xNode.DataType = "bin.base64"
xNode.Text = Split(sPath, vbLf)(1)

DropBox = StrConv(xNode.nodeTypedValue, vbUnicode)

End Function

Printing Labels on a Dymo LabelWriter 450 from VBA

How’s that title for Google-ability. Pretty saucy, I’d say. Here’s an affiliate link if you’re in the market for one of these label printers.


LabelWriter 450

Back in 2010, I was printing labels on a Dymo from VBA. At my current job, I had occasion to do it again, so I bought a LabelWriter 450 from Amazon. Seventy-five bucks! What a deal.

Previously I didn’t need anything fancy formatting-wise. I could just push some text at a DymoLabels object and print it. I’m not so lucky this time around. I really needed some underlines for visual separation of data. I don’t see any way to underline stuff through the Dymo object model. But what I did discover was that the .label files created by their software are just XML files. Woot!

Rather than trying to navigate a klunky object model, I can just write to a text file. Here’s what the new labels look like.

And here’s a piece of the XML file.


Int BOL Ext BOL Gallons Price Total







22753 6,418 2.9775 19,109.60
18318 24094018 830 3.3361 2,768.93
18318 0





The XML isn’t terribly pretty mostly because there are line feeds in there. Without the line feeds, I think it would be indented properly. Each Element tag has a String tag and an Attributes tag. It looks like every font attribute is listed whether you specifically set it or not. I’m also padding my text with spaces to line up columns. I could use multiple text boxes, but there is no grid control. For now, this works. The only downside to using one big textbox and space padding is that I have to use a fixed-width font – Courier New in this case. If I want to use a nicer font, I’ll have to go the multiple textbox route.

I have this form for data input and a button to print the label. The button kicks off the code below. I don’t need the mdyLabel variable any more because I’m not using that part of the object model. Instead of mdyLabel, I’m manipulating the XML file directly giving me more control.

Sub PrintBlendCalc()

Dim vaPrinters As Variant
Dim i As Long
Dim sFile As String

Const sMSGNODYMO As String = "Dymo label printer not found."

If mdyAddin Is Nothing Then
CreateDymoObjects
End If

If Not mdyAddin Is Nothing Then
vaPrinters = Split(mdyAddin.GetDymoPrinters, "|")
For i = LBound(vaPrinters) To UBound(vaPrinters)
If mdyAddin.IsPrinterOnline(vaPrinters(i)) Then
mdyAddin.SelectPrinter vaPrinters(i)
Exit For
End If
Next i

UpdateLabelFile sFile
mdyAddin.Open sFile
mdyAddin.Print2 1, True, 1
Else
MsgBox sMSGNODYMO, vbOKOnly
End If

End Sub

Instead of using the SetField method (like in the previous example), I call a new procedure called UpdateLabel file to create a new XML file. Then I open the file and print it.

Public Sub UpdateLabelFile(ByRef sFile As String)

Dim xDoc As MSXML2.DOMDocument
Dim xStrings As MSXML2.IXMLDOMSelection
Dim vaData As Variant

'Get the label data in an array
vaData = wshBlendCalc.Range("B2").Resize(7, 5).Value

'Create a new XML Doc and load the template label
Set xDoc = New MSXML2.DOMDocument
xDoc.Load msLABELPATH & "BlendCalc.label"

'Get all the "String" elements (there are 4)
Set xStrings = xDoc.getElementsByTagName("String")

'Change the text of the four string elements
xStrings(0).Text = FormatLabelText(vaData, 1)
xStrings(1).Text = FormatLabelText(vaData, 2) & FormatLabelText(vaData, 3)
xStrings(2).Text = FormatLabelText(vaData, 4)
xStrings(3).Text = FormatLabelText(vaData, 5) & FormatLabelText(vaData, 6) & FormatLabelText(vaData, 7)

'Save the XML file
sFile = msLABELPATH & "NewOrders\" & vaData(2, 2) & "_blend.label"
xDoc.Save sFile

'Save the data to a text file for those people who don't read XML that well
Open msLABELPATH & "NewOrders\" & vaData(2, 2) & "_blend.txt" For Output As #1
Print #1, FormatLabelText(vaData, 1) & _
FormatLabelText(vaData, 2) & _
FormatLabelText(vaData, 3) & _
FormatLabelText(vaData, 4) & _
FormatLabelText(vaData, 5) & _
FormatLabelText(vaData, 6) & _
FormatLabelText(vaData, 7)
Close #1

End Sub

There are four elements in my XML file. The first label line is underlined, so that gets its own element. The second and third lines and a portion of the fourth line have the same attributes, so they’re grouped into one element. The portion of the fourth line that is underlined is in the third element. And all the rest of the text goes into the fourth element. The elements are set and the attributes are just the way I want them, so all that is left is to update the text.

I pass the array into a FormatLabelText function which extracts the data I want and pads the spaces so the columns line up. The FormatLabelText function is shown below.

I pass the sFile variable ByRef into UpdateLabelFile. The sFile variable is set and retains that value back in the calling procedure so the calling procedure knows which file to open and print.

The FormatLabelText function takes the array and whichever row we’re interested in formatting. It starts by defining three arrays: vaBuffer defines how much padding for each of the five columns; vaAlignLeft defines if the columns are aligned right or left; and vaFormat defines the number format for each of the five column (@ is the format for general text).

Public Function FormatLabelText(ByRef vaData As Variant, ByVal lIndex As Long) As String

Dim sReturn As String
Dim vaBuffer As Variant
Dim vaAlignLeft As Variant
Dim vaFormat As Variant
Dim sData As String
Dim j As Long

vaBuffer = Array(9, 11, 11, 8, 10)
vaAlignLeft = Array(True, True, False, False, False)
vaFormat = Array("@", "@", "#,##0", "0.0000", "###,##0.00")

For j = LBound(vaData, 2) To UBound(vaData, 2)
sData = Format(vaData(lIndex, j), vaFormat(j - 1))
If Len(sData) = 0 Then
sData = Space(vaBuffer(j - 1))
ElseIf Len(sData) > vaBuffer(j - 1) Then
sData = Left$(sData, vaBuffer(j - 1) - 1) & Chr$(133)
ElseIf Len(sData) < vaBuffer(j - 1) Then If vaAlignLeft(j - 1) Then sData = sData & Space(vaBuffer(j - 1) - Len(sData)) Else sData = Space(vaBuffer(j - 1) - Len(sData)) & sData End If End If sReturn = sReturn & sData Next j FormatLabelText = sReturn & vbNewLine End Function

First the data is formatted using the Format function and the vaFormat array. Next, the big If..ElseIf..EndIf block determines how to pad the data with spaces.

  • If the data is empty (Len = 0) then write spaces for the whole buffer.
  • If the data length is greater than the buffer, truncate it and add an ellipse to the end.
  • If the data length is less than the buffer, add spaces to the end (or the beginning if it's aligned right) to fill it out.

It would be nice (but hard) to create a more general purpose function that created a label from a range. But this works for now.

KwikOpen Addin

I’ve been using this recent files userform for quite a while now and I like it. I haven’t added Eric’s comment yet (and for no good reason), but I’m going to in the next version. I don’t know if that solves the Sharepoint problem or just the ChDrive problem as neither are problems for me.

Here are my two problems:
Not enough recent files. I’m shocked – SHOCKED – at how often 50 recent files is not enough. It’s usually when I have to open a whole bunch of very similar files that I will never open again, but that clean out my recent files list. I decided to, sort of, maintain my own list. Because I use class modules *ahem* changing things to maintain my own list was pretty easy. I had to change how I fill the CRcntFiles class, but everything that consumes that class downstream just works. Here’s the new Fill method in CRnctFiles.

First, I read in the 50 Excel most recently used files. Then I read in the 1,000 most recently used files that I store in a text file, weeding out the duplicates as I go. The advantage of continuing to use the Excel MRU is that I can leverage its pinning feature. I don’t have to write my own pinning bullshit – if you want to pin something, do it via Excel and it will always be in the MRU. Awesome.

Why 1,000 files? I don’t know. We’ll see how the performance holds up. I’ve been using it for three days and my text file is only up to 58 files – the 50 Excel stores plus eight additional. I guess it will take a bit longer to get to 1,000 than I thought, but I think it will be clear when their are too many and I can pare it down.

Next I need a way to write the files back to the text file. When the userform closes, the CRcntFiles.WriteToDisk method is called.

I lazily write 1,000 lines to the disk even if I don’t have that many. I mean efficiently, not lazily. The text file is 6KB, so I’m not losing sleep over it. I would be pretty trivial to Redim Preserve that after I’ve filled it up, so I supposed I’ll do that after the alpha test.

And other than a few minor tweaks, that’s the only changes I had to make. If that’s not a case for using class modules, I don’t know what is. My userform consumes a CRcntFiles class. It doesn’t care how that class gets filled up or where the list comes from. I could change to storing those recent files in the registry, in an XML file, or tattooed to my back. As long as I can get them into a CRcntFiles instance, the rest of the code is happy.

Save As is jealous of Open. My next problem is that while I can quickly open a recent file, I can’t quickly save a file to a recent place. This is primarily a problem when I open attachments in Outlook. It stores an opened attachment in the Temp folder and when I choose Save As, that’s the folder it starts me in. Nuts to that. If you download this add-in, you’ll also see that I’ve hooked up a SaveAs userform to Ctrl+Shift+S. It’s got a few problems too (it prompts to replace a file twice), but you can try it if you like.

You can download KwikOpen.zip

The Great Hungarian Debate

I’ve discussed this in 2005. Then again in 2009. I guess it’s time to revisit the issue, mostly because Jordan says it’s time to say goodbye to hungarian notation.

I’ve probably said everything I need to on the subject, so no long diatribes here. However, I decided that I was going to experiment with coding without Hungarian and see what I thought. A little experimentation can’t be bad. I have a choice. I can be stubborn and not learn anything or I can force myself to try something different and maybe I’ll be the better for it. There was a time when I never coded custom class modules. Now you can’t get me to shut about them.

Here is the first procedure I coded in my experiment:

Public Sub ReformatDrivers()

Dim Cell As Range
Dim Found As Range

For Each Cell In Sheet1.Range("A2:A133").Cells
Set Found = Sheet2.ListObjects(1).DataBodyRange.Find(Cell.Value, , xlValues, xlWhole)
If Not Found Is Nothing Then
Cell.Offset(0, 1).Value = Sheet2.Cells(Found.Row, 2).Value
Cell.Offset(0, 2).Value = "'" & Sheet2.Cells(Found.Row, 1).Value
Cell.Offset(0, 3).Value = Found.Offset(0, 1).Value
End If
Next Cell

End Sub

Not exactly a barn burner, I’m sure you’ll agree. I hated every minute of it. I hate reading it right now. I’ve struggled to pinpoint why it displeases me so, but I have a theory.

It’s hard to tell the difference between keywords and variables. For Each Cell are all one syllable words with the first letter capitalized. The color distinction actually shows up better on this blog than it does in the IDE. I could change my color options in VBA so it stands out a little better.

There’s no requirement to make my variables proper case and thus hard to distinguish. I could code For Each cell and make my variables stand out because they’re lower case. But there is a substantial advantage to using capital letters – the IDE fixes your caps and tells you if you have a typo. So I want to have at least one capital letter to get that benefit. I could use camel case for two syllable words, like fileName. Do I have to always avoid one syllable words?

As I’ve mentioned in the past, I don’t use data type prefixes in other languages. But like this experiment, I don’t really like the variables I use when I code Ruby and I think it’s for the same reason. The difference is that my Ruby IDE doesn’t fix caps and, maybe more importantly, everything about Ruby is new and novel and foreign so on the scale of strangeness, all lower-case variables don’t really rate.

Another advantage of data type prefixing is being able to use reserved words. For my experiments, if I want to use a reserve word I’m going to tack on an underscore. When I want to code Dim lEnd As Long, I will instead use Dim End_ As Long.

I haven’t made a userform yet, but there is a problem that I’m not sure how to solve. Most of my controls have labels and any control with a label is named the same as the label. The textbox tbxSearch has lblSearch. The combobox cbxCustomer has lblCustomer. There’s real value in that and I’m not sure how to get away from it. Another problem with userforms are class properties. When I start typing Me.tbx I know I’m getting a textbox. But if my textbox is called CustomerName and I have a property of the userform class to hold a customer name, how do I distinguish them without the tbx? That’s not a rhetorical question, I really want to know how people do it.

I’ll keep writing new code without data type prefixing until I can’t take it anymore. And, of course, I’ll keep bitching about right here.

The Error Class Revisited

In the comments to Error Handling Via an Error Class, Peter found that the problem with this method is the absence of the Stop and Resume in the error handler than let you debug at the line that caused the error. Yeah, that stinks. Then Jase got me thinking that I just wouldn’t create the class in debug mode. Well, that wasn’t quite right. What needed to happen was that the error handler should not be set in debug mode. Here’s a rewrite of the entry point procedure.

Sub EntryPoint()

Dim clsError As CError

gbDebugMode = False

If Not gbDebugMode Then On Error GoTo ErrHandler

Set clsError = New CError: clsError.SetLoc "Module1", "EntryPoint"

SubProc1

ErrExit:
Exit Sub

ErrHandler:
Set clsError = Nothing
MsgBox Err.Description
Resume ErrExit

End Sub

When gbDebugMode is False, the error handler is set and it works as described in the original post. That is, the user gets a message box and the code exits gracefully. When gbDebugMode is True, the error handler is not set. It’s like you don’t have an error handler at all – because you don’t. When in debug mode, you get kicked to the line that caused the error.

Is that that last hurdle?

A VBA performance class

Hi everyone!

If you write a lot of VBA code you probably sometimes run into performance issues. A customer rings you and complains that the Excel file you built for them does not perform well. I’ve written a small article on my site, inspired by a post here: Error Handling via an Error Class. I needed a quick way to log and report performance of subroutines and I also wanted to see how many times a routine was called.

See: A VBA performance class

Enjoy!

Jan Karel Pieterse
www.jkp-ads.com