Here’s a tool to write programs for a Hansvedt MS-4 Foreman CNC EDM. The control reads and writes programs in a .TXT file format. I believe there was a standalone console/computer you could have purchased for programming at one time… but I doubt you’d find one no matter how hard you looked. Programs can be input directly on the control using the keyboard and scroll wheel of course, but that’s no fun.
All of the same functions should be available here as they are on the control. Build your program line by line, then export it to a text file:
There are also a few nifty things included: existing files can be imported, edited, then output again, and there is also a sheet for saving power settings. The spec is based on these three pages from the manual:
Transfer the file using a floppy drive (hah!) or figure out the RS-232 connection. I made this for just one person, but if you happen to find this useful please let me know, that would make my day! Download it here:
Here is an example application for some of the functions I have posted previously. This sheet will take a list of recipients as an input and generate an Outlook email for each. This came about when a colleague of mine was using the traditional mail merge in office for the first time and ran into a roadblock trying to add a CC to each message. I am not an expert with mail merge, but when I looked around the first search results suggested using a rule in Outlook as a workaround. Here’s my workaround and what it does:
Variables in the email body/subject can be entered in a similar way to mail merge, using this format <<variable>>. Just like a mad-lib.
The same attachment can be added to each message, or a unique attachment can be added for each entry on the list
Multiple recipients are added to the list by separating them with a semicolon
CC and BCC are supported
The default outlook signature can be used
Messages can be sent immediately, or displayed in the editor to be sent manually
Ultimately this is also a workaround, but there are certainly some situations where this can be useful. It’s probably not right if you’re running an email marketing campaign, or as a replacement for billing automation software; I think it is suited to one-off or infrequent tasks like:
Emailing unique coupon or gift certificate codes
Sending a reminder to vendors while including their specific account numbers
“Personalizing” an email that you would otherwise just CC or BCC to group of recipients.
Speeding up a task where humans are copy/pasting details in to a pre-written message repeatedly
This also makes it easy to be a spammer, please don’t do that. Here is the file:
Also I used some hints from Ron de Bruin to get the signature working (thanks!): https://www.rondebruin.nl/win/s1/outlook/signature.htm. Here is the subroutine that does the work, the functions it requires can be found separately here.
Sub sendEmail()
'by Elliot 8/8/20 www.elliotmade.com
'check the sheet "Instructions" for more info
'tested with office 2010 and 2013
'method for using outlook default signature taken from here: https://www.rondebruin.nl/win/s1/outlook/signature.htm
Dim rSheetName As String, vSheetName As String, iSheetName As String
'-------------------------------------
rSheetName = "Recipients"
vSheetName = "Variables"
iSheetName = "Instructions"
'-------------------------------------
Dim rSht As Worksheet, vSht As Worksheet
Set rSht = Worksheets(rSheetName)
Set vSht = Worksheets(vSheetName)
Dim rLastRow As Long, vLastRow As Long
rLastRow = getLastRow(rSheetName, 1)
vLastRow = getLastRow(vSheetName, 1)
'fixed inputs
Dim subject As String, greeting As String, body As String, signature As String, att1 As String, att2 As String, att3 As String
subject = vSht.Cells(getRowNum("Subject", vSheetName), 2).Value2
greeting = vSht.Cells(getRowNum("Greeting", vSheetName), 2).Value2
body = vSht.Cells(getRowNum("Body", vSheetName), 2).Value2
signature = vSht.Cells(getRowNum("Signature", vSheetName), 2).Value2
att1 = vSht.Cells(getRowNum("Attachment 1", vSheetName), 2).Value2
att2 = vSht.Cells(getRowNum("Attachment 2", vSheetName), 2).Value2
att3 = vSht.Cells(getRowNum("Attachment 3", vSheetName), 2).Value2
Dim mode As String, sigMode As String
mode = vSht.Cells(getRowNum("Send Mode", vSheetName), 2).Value2
sigMode = vSht.Cells(getRowNum("Signature Mode", vSheetName), 2).Value2
Dim fixedVArray As Variant
Dim fixedVCount As Long
If vSht.Cells(getLastRow(vSheetName, 1), 1).Value2 = "Variables" Then GoTo skipFixedVariables 'skip fixed variables if there are none
fixedVArray = vSht.Range(vSht.Cells(getRowNum("Variables", vSheetName, 1) + 1, 1), vSht.Cells(vLastRow, 2)).Value
fixedVCount = UBound(fixedVArray, 1)
'replace the fixed variables into each part of the email
Dim i As Long
For i = 1 To fixedVCount
If InStr(1, subject, "<<") Then
subject = Replace(subject, fixedVArray(i, 1), fixedVArray(i, 2))
End If
If InStr(1, greeting, "<<") Then
greeting = Replace(greeting, fixedVArray(i, 1), fixedVArray(i, 2))
End If
If InStr(1, body, "<<") Then
body = Replace(body, fixedVArray(i, 1), fixedVArray(i, 2))
End If
If InStr(1, signature, "<<") Then
signature = Replace(signature, fixedVArray(i, 1), fixedVArray(i, 2))
End If
Next i
skipFixedVariables:
Dim curSubject As String, curGreeting As String, curBody As String, curSignature As String
'now go through the list of recipients, update each part of the email, then create and send it
Dim listArray As Variant 'columns 1 thru 4 are fixed: TO, CC, BCC, Attachment. Any number of variable columns can follow
Dim listRowCount As Long, listColCount As Long
listRowCount = getLastRow(rSheetName)
listColCount = getLastCol(rSheetName)
If listRowCount < 2 Then 'don't proceed if the list is empty
MsgBox "Nothing found in the recipient list"
Exit Sub
End If
listArray = rSht.Range(rSht.Cells(1, 1), rSht.Cells(listRowCount, listColCount)).Value
Dim j As Long
Dim k As Long
Dim outlookApp As Object
Dim outlookEmail As Object
Set outlookApp = CreateObject("Outlook.Application")
For j = 2 To UBound(listArray, 1)
'reset the temporary message parts
curSubject = subject
curGreeting = greeting
curBody = body
curSignature = signature
If UBound(listArray, 2) > 4 Then 'if there are variable columns, replace each of those into the current message
For k = 5 To UBound(listArray, 2)
If InStr(1, curSubject, "<<") Then
curSubject = Replace(curSubject, listArray(1, k), listArray(j, k))
End If
If InStr(1, curGreeting, "<<") Then
curGreeting = Replace(curGreeting, listArray(1, k), listArray(j, k))
End If
If InStr(1, curBody, "<<") Then
curBody = Replace(curBody, listArray(1, k), listArray(j, k))
End If
If InStr(1, curSignature, "<<") Then
curSignature = Replace(curSignature, listArray(1, k), listArray(j, k))
End If
Next k
End If
'compose the email
Set outlookEmail = outlookApp.CreateItem(0)
With outlookEmail
If sigMode = "Outlook Default" Then 'in order to get the predefined signature from outlook into the message it has to be displayed first
.display
.HTMLbody = curGreeting & "<br>" & curBody & "<br>" & .HTMLbody
Else
.HTMLbody = curGreeting & "<br><br>" & curBody & "<br><br>" & curSignature
End If
.To = listArray(j, 1)
.cc = listArray(j, 2)
.bcc = listArray(j, 3)
.subject = curSubject
'attachments
If att1 <> "" Then .Attachments.Add (att1)
If att2 <> "" Then .Attachments.Add (att2)
If att3 <> "" Then .Attachments.Add (att3)
If listArray(j, 4) <> "" Then .Attachments.Add (listArray(j, 4))
If mode = "Send" Then
.send
Else
.display
End If
End With
Set outlookEmail = Nothing
Next j
Set outlookApp = Nothing
Debug.Print
End Sub
Here are two functions that I will be using in an upcoming sheet, I want to explain them briefly and add them to my small library (file is downloadable at the end of this post).
The names hint at the purpose: given a value to match, they will return the number of the row or column the value was found in, or zero if it wasn’t found at all. The concept is similar to the “vlookup” formula, but performance for these two functions is terrible by comparison and for that reason I don’t recommend using them repetitively in a loop or with large columns of data. I maintain several files with built-in functionality where most of the user input comes from cells in a sheet but I can’t always guarantee the position of those cells – that’s where these two come in handy. Instead of hard-coding the cell address, these functions can find the address by matching the value in that cell which allows you to modify the user-facing sheet without having to update code every time; it also makes the sheet somewhat tolerant of being rearranged by the user, but you need to be careful in case it’s been mangled in such a way that the inputs are found but are totally bogus.
getRowNum()
Function getRowNum(findValue As Variant, Optional sheetName As String, Optional colNum As Long) As Long
'by Elliot 8/9/20 www.elliotmade.com
'this function will return the row number in the first (or specified) column that matches the "findValue" parameter
'this is similar to vlookup, but not as fast or performant
'an example use is to get an input from a sheet where you can't guarantee the position of the cell
'combine this with getColNum() to find a cell value where a known column heading and row label intersect
'****** this requires the "getlastrow" function *******
Dim i As Long
Dim lastRow As Long
Dim j As Long
If sheetName <> "" Then
For j = 1 To Worksheets.Count
If Worksheets(j).Name = sheetName Then GoTo sheetOK
Next j
GoTo abort 'specified sheet name was not found
sheetOK:
End If
'default values for optional parameters
If sheetName = "" Then sheetName = ActiveSheet.Name
If colNum = 0 Then colNum = 1
lastRow = getLastRow(sheetName, colNum)
For i = 1 To lastRow
If Worksheets(sheetName).Cells(i, colNum).Value2 = findValue Then
getRowNum = i
GoTo found
End If
Next i
found:
abort:
End Function
getColNum()
Function getColNum(findValue As Variant, Optional sheetName As String, Optional rowNum As Long) As Long
'by Elliot 8/9/20 www.elliotmade.com
'this function will return the column number in the first (or specified) column that matches the "findValue" parameter
'this is similar to vlookup, but inverted not as fast or performant
'an example use is to get an input from a sheet where you can't guarantee the position of the cell
'combine this with getRowNum() to find a cell value where a known column heading and row label intersect
'****** this requires the "getLastCol" function *******
Dim i As Long
Dim lastCol As Long
Dim j As Long
If sheetName <> "" Then
For j = 1 To Worksheets.Count
If Worksheets(j).Name = sheetName Then GoTo sheetOK
Next j
GoTo abort 'specified sheet name was not found
sheetOK:
End If
'default values for optional parameters
If sheetName = "" Then sheetName = ActiveSheet.Name
If rowNum = 0 Then rowNum = 1
lastCol = getLastCol(sheetName, rowNum)
For i = 1 To lastCol
If Worksheets(sheetName).Cells(rowNum, i).Value2 = findValue Then
getColNum = i
GoTo found
End If
Next i
found:
abort:
End Function
The usage for both of these is simple, just give them a value to match, and if you want to search in a different row/column or a different sheet use the optional parameters. Note that these both rely on two functions I posted previously – getLastRow() and getLastCol(), both of which are included in the file below as well.
Building on the previous posts getLastRow() and getLastCol(), here is an example application of those techniques.
There are many ways to have alternating background color on rows in Excel: there’s a built-in option if you are working with a table, you can use conditional formatting with a formula, or add a helper column to filter and highlight manually. I find that having the color alternate on every single row doesn’t always suit the data I am working with however – often I would rather have the color change help me identify changes in one or more columns that are sorted so I can notice where one chunk ends and another begins.
This macro considers the content of the column(s) that are selected and alternates the background color each time it changes. This is probably easier to understand in a picture, so here we go:
The concept is simple: starting from the top, every time the contents of the selected column differ from the row above, that group of cells will either be highlighted or left alone. I designed this so that multiple columns could be selected – in the animation above you can see at first when only column A is selected that there are three highlighted groups, but when A:C is selected that there are six groups of rows.
If only a range of cells are selected rather than an entire column, the highlighting will be confined to those rows. When the entire column is selected it will only extend to the last used row and ignore the blanks at the bottom of the sheet – this is where the getLastRow() function comes into play. Additionally, the highlighted area stretches from column A to the last used column – found with the getLastCol() function.
The Code
Sub colorBands()
'highlight a range that contains the changing values to higlight by
'the range from column A to the last column will be alternatingly highlighted
'not intended for non-continuous selections
Dim s As Worksheet
Set s = ActiveSheet
Dim startRowNum As Long
Dim endRowNum As Long 'if the whole column is selected, only higlight to the last used row
Dim startColNum As Long
Dim endColNum As Long
Dim prevValue As Variant
Dim values As Variant 'the whole set will be added to an array for comparison
Dim startRows As Variant 'each set of rows will have a start and end in an array
Dim endRows As Variant
Dim rowOffset As Long 'difference between the row number and the counter variables
Dim colOffset As Long
Dim rowCount As Long
Dim colCount As Long
Dim lastCol As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long 'skip L because it's hard to differentiate from i
Dim n As Long
Dim tempValue As Variant
Dim highlight As Boolean
ReDim values(1 To 1)
'find the boundaries of the selection
endColNum = getLastCol()
endRowNum = getLastRow()
startColNum = Selection.Column
startRowNum = Selection.row
endColNum = startColNum + Selection.Columns.Count - 1
If startRowNum + Selection.Rows.Count < endRowNum Then endRowNum = startRowNum + Selection.Rows.Count - 1 'reset the row limit to highlight if the selection doesn't reach the end of the data in that column
rowOffset = startRowNum - 1
colOffset = startColNum - 1
rowCount = endRowNum - startRowNum + 1
colCount = endColNum - startColNum + 1
lastCol = getLastCol(, startRowNum)
'Some output for troubleshooting
Debug.Print "Starting Column: " & startColNum
Debug.Print "Ending Column: " & endColNum
Debug.Print "Starting Row: " & startRowNum
Debug.Print "Ending Row: " & endRowNum
Debug.Print "Offset from row 1 by: " & rowOffset
Debug.Print "Row Count: " & rowCount
Debug.Print "Column Count: " & colCount
'add the values to an array
If startColNum = endColNum Then
For i = 1 To rowCount
ReDim Preserve values(1 To i)
values(i) = s.Cells(i + rowOffset, startColNum).Value
Next i
Else
For i = 1 To rowCount
ReDim Preserve values(1 To i)
For j = 1 To colCount
tempValue = tempValue & s.Cells(i + rowOffset, j + colOffset).Value
Next j
values(i) = tempValue
tempValue = Empty
Next i
End If
'define the ranges that need to be higlighted
ReDim startRows(1 To 1)
ReDim endRows(1 To 1)
startRows(1) = startRowNum
m = 1
highlight = False
For k = 2 To rowCount
If values(k) <> values(k - 1) Then 'this row is different from the previous, so it should start or end a higlighted area
If highlight = False Then 'start a highlighted area
ReDim Preserve startRows(1 To m)
ReDim Preserve endRows(1 To m)
highlight = True
startRows(m) = k
Else 'end a highlighted area
highlight = False
endRows(m) = k - 1
m = m + 1
End If
End If
Next k
If highlight = True Then endRows(m) = endRowNum - rowOffset 'close the last range if it's dangling
'Highlight each block
For n = 1 To UBound(startRows)
s.Range(s.Cells(startRows(n) + rowOffset, 1), s.Cells(endRows(n) + rowOffset, lastCol)).Interior.ColorIndex = 4 'change this for a different color
Next n
End Sub
How to use it
In order to use this, I recommend adding it to your personal.xlsb file and mapping it to a button in the toolbar or a keyboard shortcut. The two functions getLastRow() and getLastCol() are also required, so those will also have to be added to the file. As I write more of these shared functions I will keep a single file up to date here to make this installation easier (link directly below).
Save frequently, particularly before executing a macro. You cannot undo a macro, if something goes wrong you could lose work.
Clear existing background colors before using this
Change the color to something other than green if you prefer
Avoid using this while filtered or with discontinuous selections, or you may get unexpected results
This isn’t optimized for performance in any way, so be wary when using it on something large for the first time. For 50k rows it took ~5 seconds on my machine.
Similar to my previous post on finding the last used row in a sheet, this is a function that can be used to find the last used column. These two functions work nicely together to limit a loop or define a range when the source data may vary in size.
The function: getLastCol():
If called with no parameters, the last used column in the active worksheet will be returned.
The optional sheetName parameter lets you reference a sheet other than the one that is active.
The optional rowNum parameter returns the last used column in a particular row.
The optional colLimit parameter limits the total number of iterations in the loop when searching for the last used column, this can be used to speed up execution when you have an idea of what the sheet may contain already.
If there is an error with the parameters it will return zero
Examples:
getLastCol() = 3
getLastCol("Fruit") = 3
getLastCol(,3) = 2 'last used column on row 3 only
getLastCol(Vegetables) = 0 'this sheet name does not exist
The Code:
Function getLastCol(Optional sheetName As String, Optional rowNum As Long, Optional colLimit As Long) As Long
'by Elliot 7/22/20 www.elliotmade.com
'this function will return the last used column on a sheet in a single row
'if no sheet name is specified it will use the active sheet
'if no row is specified it will find the last column in any row up to an optional limit (for faster performance)
'two assumptions are made: the file type is .xlsx or similar that supports 16k columns
'and the sheet is in the active workbook
'a zero returned means that there was a failure
Dim i As Long
Dim j As Long
Dim curLastCol As Long
'check for valid inputs first, return zero if there is a problem
If rowNum < 0 Or rowNum > 1048575 Then GoTo abort
If sheetName <> "" Then
For i = 1 To Worksheets.Count
If Worksheets(i).Name = sheetName Then GoTo sheetOK
Next i
GoTo abort 'specified sheet name was not found
sheetOK:
End If
If colLimit = 0 Then
colLimit = 16384
ElseIf colLimit < 0 Or colLimit > 16384 Then
GoTo abort
End If
If sheetName = "" Then sheetName = ActiveSheet.Name
'if no problem, find the last column
If rowNum = 0 Then
getLastCol = Worksheets(sheetName).Cells(1, 16384).End(xlToLeft).Column
For j = 1 To colLimit
If Worksheets(sheetName).Cells(1048575, j).End(xlUp).Row > 1 Then curLastCol = j
If curLastCol > getLastCol Then getLastCol = curLastCol
Next j
Else
getLastCol = Worksheets(sheetName).Cells(rowNum, 16384).End(xlToLeft).Column
End If
abort:
End Function
You may notice that the method using xlToLeft is used to find the last column in a specific row, but I did not use it when searching for the last column in the entire sheet; to do this in a loop would require iterating through every single row (over 1M!) and would take a significant amount of time. I chose to do two things to shortcut this process: first, check the first row because it often has headings for the rest of the document, and second, find the last used row in every column instead. This limits the possible trips through the loop to 16k at most (the number of columns in a sheet). I have some other ideas to improve on this, but I’ll leave it alone for now until it becomes a bottleneck.
Next I’ll post an example that puts this function to use, stay tuned.