# Userform for getting data from data sheet into a table

I am making a userform that grabs data from a data sheet and puts it into a table:

1. Grabs the data based on what the user wants (Brand -> Items for brand)
2. Allows multiple items to be added
3. Displays the info about the items
4. Allows the user to specify how many of each item (for when the data is put into the inventory table)

I am just looking for any suggestions on how I could make my code better, specifically with error handling and lowering memory footprint. I am a novice, so some of this code could have better approaches. If so, please tell me.

UserForm:

ThisWorkBook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.AutoCorrect.AutoFillFormulasInLists = True
End Sub

Private Sub Workbook_Open()
Application.AutoCorrect.AutoFillFormulasInLists = False
End Sub


Private Sub cbAddItemUserForm_Click()

End Sub


UserForm:

Public brand_edit As Variant
Public cBook As Workbook
Public cSheet As Worksheet
Public dSheet As Worksheet
Public specLink As Variant
Public itemAddress As Variant
Public itemID As String
Public inventoryTable As ListObject
Public x As Long
Public quantity As String

Private Sub MultiPage1_Change()

End Sub

Private Sub UserForm_Activate()

Me.tbQuantity.Text = "1"

End Sub

Public Sub cmbBrand_Change()

Me.tbQuantity.Text = "1"

Dim brand As Variant
brand = cmbBrand.Value
brand_edit = Replace(brand, " ", "_")
brand_edit = Replace(brand_edit, """", "")
brand_edit = Replace(brand_edit, "-", "")
brand_edit = Replace(brand_edit, "(", "")
brand_edit = Replace(brand_edit, ")", "")
brand_edit = Replace(brand_edit, "&", "and")
brand_edit = Replace(brand_edit, ".", "")
brand_edit = Replace(brand_edit, ",", "")
brand_edit = Replace(brand_edit, ", ", "_")
brand_edit = Replace(brand_edit, "__", "_")
brand_edit = LCase(brand_edit)

'On Error Resume Next
'If brand_edit = "" Then
'    cmbItemID.RowSource = ""
'Else

On Error Resume Next

If Err = 380 Then
Exit Sub
Else
cmbItemID.RowSource = brand_edit

End If

Err.Clear

On Error GoTo 0

cmbItemID.Text = ""

End Sub

Private Sub cmbItemID_Change()

Me.tbQuantity.Text = "1"

Dim brandTable As String
Dim i As Long
Dim dataTable As ListObject

Set cBook = ActiveWorkbook
Set cSheet = cBook.Sheets("Gen. Info")
Set dSheet = cBook.Sheets("DATA")

itemID = cmbItemID.Value
brandTable = brand_edit

On Error Resume Next
Set dataTable = dSheet.ListObjects(brand_edit)

For i = 1 To dataTable.ListRows.Count
If dataTable.ListColumns(1).DataBodyRange.Rows(i) = itemID Then

tbDescription.Text = dataTable.ListColumns(3).DataBodyRange.Rows(i).Value
tbSpecs.Text = dataTable.ListColumns(4).DataBodyRange.Rows(i).Formula
tbListPrice.Text = dataTable.ListColumns(5).DataBodyRange.Rows(i).Value
tbCost.Text = dataTable.ListColumns(6).DataBodyRange.Rows(i).Value
tbNotes.Text = dataTable.ListColumns(7).DataBodyRange.Rows(i).Value
Exit For

Else
End If

Next

End Sub
Private Sub cbSpecs_Click()
Dim specLink_edit As Variant
If specLink_edit = "" Then
Exit Sub
Else
End If

End Sub

Private Sub cbSubmit_Click()

Dim i As Long
Dim v As Variant
Dim vTable() As Variant

'add error handling here (if no cmbBrand change has occured, hitting submit will error)
Set inventoryTable = cSheet.ListObjects("inventory_table")
colItemID = inventoryTable.ListColumns("Item #").Index
colSpecs = inventoryTable.ListColumns("Specs").Index
colQty = inventoryTable.ListColumns("Qty").Index

v = inventoryTable.DataBodyRange.Rows
ReDim vTable(1 To UBound(v, 1), 1 To 5)
For i = 0 To lbItemList.ListCount - 1

vTable(i + 1, 1) = "=DATA!" & lbItemList.List(i, 2)
vTable(i + 1, 5) = lbItemList.List(i, 3)

If specLink = "" Then

ElseIf specLink <> "" Then

vTable(i + 1, 4) = lbItemList.List(i, 1)

End If
inventoryTable.ListColumns("Item #").DataBodyRange(i + 1, colItemID).Value = vTable(i + 1, 1)
inventoryTable.ListColumns("Specs").DataBodyRange(i + 1).Value = vTable(i + 1, 4)
inventoryTable.ListColumns("Qty").DataBodyRange(i + 1).Value = vTable(i + 1, 5)
Next

End Sub
quantity = Me.tbQuantity.Text

If Me.lbItemList.ListCount = 0 Then
x = 0
End If

With Me.lbItemList
Me.lbItemList.ColumnCount = 4
.List(x, 0) = itemID
.List(x, 1) = specLink
.List(x, 2) = itemAddress
.List(x, 3) = quantity
x = x + 1

End With

End Sub

Private Sub cbRemoveItems_Click()

For intCount = lbItemList.ListCount - 1 To 0 Step -1
If lbItemList.Selected(intCount) Then lbItemList.RemoveItem (intCount)
Next intCount

End Sub


## Option Explicit

Go to Tools -> Options -> Require Variable Declaration. This will insert Option Explicit at the top of every new module you create. Option Explicit will enforce that every variable you use is declared. This will prevent all sorts of bugs, mainly due to preventing typos.

Separation of concerns

You should never have business logic contained directly in your event triggers. It means your code is scattered around, is not easily find-able, and is very tightly coupled with your form. You should separate out your logic into Sub/Functions which your event handlers can then call.

Take this for instance:

Public Sub cmbBrand_Change()

Me.tbQuantity.Text = "1"

Dim brand As Variant
brand = cmbBrand.Value
brand_edit = Replace(brand, " ", "_")
brand_edit = Replace(brand_edit, """", "")
brand_edit = Replace(brand_edit, "-", "")
brand_edit = Replace(brand_edit, "(", "")
brand_edit = Replace(brand_edit, ")", "")
brand_edit = Replace(brand_edit, "&", "and")
brand_edit = Replace(brand_edit, ".", "")
brand_edit = Replace(brand_edit, ",", "")
brand_edit = Replace(brand_edit, ", ", "_")
brand_edit = Replace(brand_edit, "__", "_")
brand_edit = LCase(brand_edit)


That whole brand_edit thing should be a Function. Maybe something called CleanBrandName which takes a brandName as an argument and returns a cleaned version:

Public Function CleanBrandName(ByVal brandName As String) As String

Dim cleanName  As String
cleanName = brandName

cleanName = Replace(cleanName, " ", "_")
cleanName = Replace(cleanName, ", ", "_")
cleanName = Replace(cleanName, "__", "_")

cleanName = Replace(cleanName, """", "")
cleanName = Replace(cleanName, "-", "")
cleanName = Replace(cleanName, "(", "")
cleanName = Replace(cleanName, ")", "")
cleanName = Replace(cleanName, ".", "")
cleanName = Replace(cleanName, ",", "")

cleanName = Replace(cleanName, "&", "and")

cleanName = LCase(cleanName)

CleanBrandName = cleanName

End Function


And now your cmbBrand_Change can just go:

Public Sub cmbBrand_Change()

Me.tbQuantity.Text = "1"

Dim brand As Variant
brand = cmbBrand.Value
brand = CleanBrandName(brand)


And when you find new cases that need to be handled by CleanBrandName you know where to find it and that you only need to change it in that one place. If you ever need to clean a brand name somewhere else in your code, you can just call that function rather than copy-pasting all the logic again.

Keep your code tidy and organised

'On Error Resume Next
'If brand_edit = "" Then
'    cmbItemID.RowSource = ""
'Else

On Error Resume Next

If Err = 380 Then
Exit Sub
Else
cmbItemID.RowSource = brand_edit

End If

Err.Clear

On Error GoTo 0

cmbItemID.Text = ""


This is just a mess. Don't leave commented-out code in your codebase, get yourself some proper Source Control (I highly recommend RubberDuck which is an Add-In that provides, among other awesome things, Git Integration for the VBE).

On Error Resume Next is a very dangerous command that should be avoided wherever possible and, if not, then used under tightly-defined circumstances.

This is an appropriate way to use it:

itemValue = empty

'/ Will error if the key does not exist
On Error Resume Next
itemValue = collection.Item(key)
On Error Goto 0

If not IsEmpty(itemValue) Then
'/ Key Exists, Do Stuff
Else
'/ Handle missing Key
End If


We have a statement which may cause an error, so we temporarily disable error handling for that statement, immediately re-enable it afterwards and immediately handle the error if it occurred. And we leave a comment explaining what error we were expecting and why we're doing things this way.

Back to your code, this is pointless:

On Error Resume Next

If Err = 380 Then
Exit Sub
Else


If an error had already occurred before On Error... then the program would've stopped already and thrown an error message, so checking after the fact is not useful.

What on earth is this doing?

cmbItemID.RowSource = brand_edit


.RowSource is supposed to be used to set a valid Range Reference, like say "A10" or "NamedRange". How a brandName fits in to that is incredibly unclear.

Err.Clear

On Error GoTo 0


If you're expecting an error, then handle the error you're expecting. Don't just dismiss any error whatsoever. Errors are important. Errors are useful. Errors should not be ignored unless you can articulate precisely what you're ignoring and why.

cmbItemID.Text = ""

End Sub


And you're just clearing the box at the end of the sub anyway? So why on earth have this change event in the first place?

This is why explanatory comments are important. If your code is doing something, and the thing is not immediately obvious, you should leave a comment explaining what's going on and why.

• I did the separation stuff you mentioned at the top and turned on the Option Explicit. I tidied my code a bit. I used On Error Resume Next because it was the fastest way to get rid of that error. The error is caused by there not being a table that uses the name of brand_edit (now brandTableName). This error will not occur once I edit the DATA page that has all the tables to include all the tables. So once I fix that I will get rid of the error handling for that. I am clearing the text of the ItemID combo box so when a brand_change occurs the selected item is cleared. – JED Jun 18 '16 at 4:43
• The point of the brand_change is to convert the brand name to a valid table name (aka a table range). cmbItemID then uses that table name to get its data. – JED Jun 18 '16 at 4:45
• Thanks for all these suggestions. They really helped make my code cleaner and more effective. I expect when I code the other parts of this excel sheet I will benefit from these changes. – JED Jun 18 '16 at 4:46
• Oh, and I will also look into Rubberduck. Thanks for the reference. – JED Jun 18 '16 at 5:24

Here is an afterthought on your cmbBrand_Change() event.

Function AdjustBrandValue(ByVal strChar As String) As String

Dim i As Integer
Dim strResult As String

For i = 1 To Len(strChar)
Select Case Asc(Mid(strChar, i, 1))
Case 32, 48 To 57, 65 To 90, 97 To 122:
strResult = strResult & Mid(strChar, i, 1)
Case 95
strResult = strResult & " "
Case 38
strResult = strResult & "and"
End Select
Next i
AdjustBrandValue = Replace(WorksheetFunction.Trim(strResult), " ", "_")

End Function


Then call the Function as Zak noted above:

Public Sub cmbBrand_Change()

Dim brand As Variant

End Sub


This will examine the Ascii value for each character in the string and keep only alphanumeric values. It will also change the _ to (space) and the & to "and". Then it will trim the string and replace the spaces with _. It helps by your not having to account for every possible scenario (i.e. ,(space) or __ or some other non-alphanumeric character).

Here is the Ascii Table: http://www.asciitable.com/

• Thank you for this suggestion. I took this and Zak's suggestion. I edited my original post with the new code. – JED Jun 18 '16 at 4:31

CleanSpecHyperlink returns an empty string.

Change

cleanSpecLink = cleanLink


To

CleanSpecHyperlink = cleanLink


brandTableName is a const and belongs in a Public code module.

Sub cmbItemID_Change: Modifications

• Iterate Each Row in datatable
• Group all variable assignments together
• Remove On Error Resume Next
• itemAddress and tbAddress.Text refer to the same value. Is itemAddress needed?

This works fine but is not very flexible:

tbDescription.Text = dataTable.ListColumns(3).DataBodyRange.Rows(i).Value


A better way is to use an enumeration and function in a public module to give you a cell reference. This way you can easily update your code if you have to add, remove or rearrange columns in your table.

In a public module:

Option Explicit
Public Enum BrandColumn
bcDescription = 3
bcSpecs
bcListPrice
bcNotes
bcCost
End Enum

Dim brandTable As String
Dim datatable As ListObject
Dim r As Range

Set datatable = dSheet.ListObjects(brand_edit)

For Each r In datatable.DataBodyRange.Rows

If r.Columns(bcItemAddress) = cmbItemID.Value Then
tbDescription.Text = r.Columns(bcDescription).Value
tbSpecs.Text = r.Columns(bcSpecs).Formula
tbListPrice.Text = r.Columns(bcListPrice).Value
tbCost.Text = r.Columns(bcCost).Value
tbNotes.Text = r.Columns(bcNotes).Value