Excel VBA Macro - Can it be simplified or structured differently? - excel

Question

I made a simple VBA macro that I run against a CSV file that I open in excel. This macro formats the sheet, deletes certain data, inserts columns, etc. It then copies the properly formatted CSV to a server where the data is imported into our ERP. The CSV file is a Bill of Material and everything works great. I am wondering if it could be simplified. When I import this macro as an excel add-in, instead of showing one macro, it shows all the various sub-routines within the macro, along with the main sub that calls all the other subs in the order I need them to run. Is there a better way to arrange this code?
Sub ProcessBOM()
Call DeleteColumn
Call DelBinFill
Call DelBlankRows
Call Insert3Columns
Call DelRow1
Call ClearColumns
Call InsertProjectName
Call InsertLineItemNo
Call InsertEA
Call MoveColumn
Call InsertDate
Call GetUserName
Call SaveAs
Call MessageBox
End Sub
'Delete first column
Sub DeleteColumn()
Columns(1).EntireColumn.Delete
End Sub
'Delete rows containing BIN FILL
Sub DelBinFill()
Dim i As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "BIN FILL" Then Cells(i, 1).EntireRow.Delete
Next i
End Sub
'Delete rows with blank RDI Item #
Sub DelBlankRows()
Dim i As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "" Then Cells(i, 1).EntireRow.Delete
Next i
End Sub
'Insert 3 blank columns
Sub Insert3Columns()
Range("A:C").EntireColumn.Insert
End Sub
'Delete Row 1
Sub DelRow1()
Rows(1).EntireRow.Delete
End Sub
'Clear Contents of specified columns
Sub ClearColumns()
Range("E:G").EntireColumn.Clear
End Sub
'Grabs Project Name from Active Sheet and inserts to last row
Sub InsertProjectName()
Dim LastRow As Long
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("C1:C" & LastRow) = ActiveSheet.Name
End Sub
'Insert Line Item Numbers
Sub InsertLineItemNo()
ActiveCell.FormulaR1C1 = "1"
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Selection.AutoFill Destination:=Range("A1:A" & LastRow), Type:=xlFillSeries
End Sub
'Insert EA Into Column E
Sub InsertEA()
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("E1:E" & LastRow) = "EA"
End Sub
' Moves QTY Data from H to F
Sub MoveColumn()
Columns("H:H").Select
Selection.Cut Destination:=Columns("F:F")
Columns("F:F").Select
End Sub
'Insert Date Into Column G
Sub InsertDate()
Dim LDate As String
LDate = Date
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("G1:G" & LastRow).Resize(, 2) = Array(Date, "=""""")
End Sub
'Get logged on username and insert into Column B
Sub GetUserName()
Dim strName As String
strName = Environ("UserName")
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Range("B1:B" & LastRow) = strName
End Sub
'Save file
Sub SaveAs()
Application.DisplayAlerts = False
MyName = ActiveSheet.Name
ActiveWorkbook.SaveAs Filename:="\\navapp1svr\boms$\solidworks\inbound" & "\" & MyName & ".csv", FileFormat:=xlText
ActiveWorkbook.Saved = True
ActiveWorkbook.Close SaveChanges:=False
End Sub
'Prompt the user to verify data upload in Microsoft Dynamics NAV
Sub MessageBox()
MsgBox ("BOM upload complete. Please check Dynamics for accuracy.")
End Sub

Answer 1

I think this is primarily opinion based, but I have a strong opinion here so I'm sharing it. I feel like your code is way over-refactored and there is some extra superfluous stuff in here (variables being set but never used, .SELECT being used to copy/paste, variables declared and set and then only used once)
Consider a single routine:
Sub ProcessBOM()
Dim i As Integer
'Delete first column
Columns(1).EntireColumn.Delete
'Delete rows containing BIN FILL or Nothing
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "BIN FILL" OR Cells(i, 1) = "" Then Cells(i, 1).EntireRow.Delete
Next i
'Insert 3 blank columns
Range("A:C").EntireColumn.Insert
'Delete Row 1
Rows(1).EntireRow.Delete
'Clear Contents of specified columns
Range("E:G").EntireColumn.Clear
'Define last used row
Dim LastRow As Long
LastRow = Range("D" & Rows.Count).End(xlUp).Row
'Grabs Project Name from Active Sheet and inserts to last row
Range("C1:C" & LastRow) = ActiveSheet.Name
'Insert Line Item Numbers
'What is this. How do you know what the "ActiveCell" is at this point or what is "Selected"
'Commenting out because this is risky. Explicitly set which cells you want to do this to
'ActiveCell.FormulaR1C1 = "1"
'Selection.AutoFill Destination:=Range("A1:A" & LastRow),Type:=xlFillSeries
'Insert EA Into Column E
Range("E1:E" & LastRow) = "EA"
' Moves QTY Data from H to F
Columns("H:H").Cut Destination:=Columns("F:F")
'Insert Date Into Column G
Range("G1:G" & LastRow).Resize(, 2) = Array(Date, "=""""")
'Get logged on username and insert into Column B
Range("B1:B" & LastRow) = Environ("UserName")
'Save file
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="\\navapp1svr\boms$\solidworks\inbound" & "\" & ActiveSheet.Name & ".csv", FileFormat:=xlText
ActiveWorkbook.Saved = True
ActiveWorkbook.Close SaveChanges:=False
'Prompt the user to verify data upload in Microsoft Dynamics NAV
MsgBox ("BOM upload complete. Please check Dynamics for accuracy.")
End Sub
It's only 54 rows including comments and whitespace . In fact, it's only 23 lines of actual code. It's very clear what each step is doing and it can be read by a human without bouncing from the top routine down to whatever step is next. Your getting really close to spaghetti-code and you don't want to go there.
Expanding this out into 15 subroutines doesn't really make sense as they don't really encapsulate much more than a line or two of code and they aren't terribly reusable as they all do a VERY specific thing to a specific range that is only applicable at a single point-in-time while your code is running. If you have more code that may need to reuse some of the code that is present here, then MAYBE consider separating out the logic into it's own subroutine.
There are some pieces that might make sense as their own subroutine or function. For instance you have two routines that are similar DelBinFill and DelBlankRows. These could be written as a single routine with a parameter:
Sub DelRows(criteria As String)
Dim i As Integer
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = criteria Then Cells(i, 1).EntireRow.Delete
Next i
End Sub
And called like:
Call DelRows("Bin Fill")
Call DelRows("")
But... now you have to loop through the same range twice and delete rows. It would be MUCH more efficient to loop once (as I do above) and delete based on both criteria.