10
\$\begingroup\$

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:

enter image description here

ThisWorkBook:

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

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

Add Item Button:

Private Sub cbAddItemUserForm_Click()

ufItemAdd.Show

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
    specLink = 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
    itemAddress = dataTable.ListColumns(1).DataBodyRange.Rows(i).Address
    tbAddress.Text = itemAddress
    Exit For

    Else
    End If

Next



End Sub
Private Sub cbSpecs_Click()
Dim specLink_edit As Variant
specLink_edit = Replace(specLink, "=HYPERLINK(", "")
specLink_edit = Replace(specLink_edit, ")", "")
specLink_edit = Replace(specLink_edit, ",", "")
specLink_edit = Replace(specLink_edit, """", "")
specLink_edit = Replace(specLink_edit, "Specs", "")
If specLink_edit = "" Then
    Exit Sub
Else
cBook.FollowHyperlink (specLink_edit)
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

Unload Me
End Sub
Private Sub cbAddItem_Click()
quantity = Me.tbQuantity.Text

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

With Me.lbItemList
    Me.lbItemList.ColumnCount = 4
    .AddItem
    .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
\$\endgroup\$
6
\$\begingroup\$

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.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – JED Jun 18 '16 at 4:43
  • \$\begingroup\$ 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. \$\endgroup\$ – JED Jun 18 '16 at 4:45
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ – JED Jun 18 '16 at 4:46
  • 1
    \$\begingroup\$ Oh, and I will also look into Rubberduck. Thanks for the reference. \$\endgroup\$ – JED Jun 18 '16 at 5:24
3
\$\begingroup\$

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
brand = AdjustBrandValue(cmbBrand.Value)

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/

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thank you for this suggestion. I took this and Zak's suggestion. I edited my original post with the new code. \$\endgroup\$ – JED Jun 18 '16 at 4:31
3
\$\begingroup\$

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
    bcItemAddress = 1
    bcDescription = 3
    bcSpecs
    bcSpecLink
    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
        specLink = r.Columns(bcSpecLink).Formula
        tbListPrice.Text = r.Columns(bcListPrice).Value
        tbCost.Text = r.Columns(bcCost).Value
        tbNotes.Text = r.Columns(bcNotes).Value
        itemAddress = r.Columns(bc).Address
        tbAddress.Text = itemAddress
        Me.tbQuantity.Text = "1"
        Exit For
    End If

Next

This is much easier to read, debug, and modify. (Enumeration Reference)

enter image description here

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ So in implementing this into my code, I ran into a few problems. I can't set brandTableName to "BrandTable" because brandTableName is = to the name of the selected brand's table. I need brandTableName to = what it does in my UserForm code. I also ran into a problem with dSheet not being recognized as a defined variable of my worksheet because it is defined as public in my userform code instead of in the module code. How do I fix this? Same thing with DataTable. \$\endgroup\$ – JED Jun 19 '16 at 5:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.