Can someone please shorten this VBA code for me? For a userform

jbalth · Apr 26th 2016

Hi There,

I've never studied VBA, as a result I tend to do things the long way. Because there are so many combo boxes, this seems to be running slowly.

Could someone let me know if there is a way to speed up this code? It's for a userform that's taking too long to initialise

Thanks Heaps!

Code

Private Sub UserForm_Initialize()
With ComboBox8
.AddItem ("No")
.AddItem ("Yes")
End With
 
 


DTPicker1.SetFocus
With ComboBox4
.AddItem ("Patron")
.AddItem ("Staff")
.AddItem ("Contractor")
End With


With ComboBox3
  Dim c As Range
    
    With Sheets("Lists")
        For Each c In .Range("C:C", .Range("C" & Rows.Count).End(xlUp))
            If c.Value <> "" Then ComboBox3.AddItem c.Value
        Next c
    End With
    
End With
 
With ComboBox1
.AddItem "Male"
.AddItem "Female"
End With
With ComboBox5
.AddItem ("Front")
.AddItem ("Back")
.AddItem ("Both")
End With


With ComboBox6
Dim e As Range
    
    With Sheets("Lists")
        For Each e In .Range("E:E", .Range("E" & Rows.Count).End(xlUp))
            If e.Value <> "" Then ComboBox6.AddItem e.Value
        Next e
    End With
    
End With
With ComboBox2
Dim d As Range
    
    With Sheets("Lists")
        For Each d In .Range("D:D", .Range("D" & Rows.Count).End(xlUp))
            If d.Value <> "" Then ComboBox2.AddItem d.Value
        Next d
    End With
    
End With


With ComboBox7
Dim f As Range
    
    With Sheets("Lists")
        For Each f In .Range("G:G", .Range("G" & Rows.Count).End(xlUp))
            If f.Value <> "" Then ComboBox7.AddItem f.Value
        Next f
    End With
    
End With
 
 
With ComboBox9
Dim h As Range
    
    With Sheets("Lists")
        For Each h In .Range("J:J", .Range("J" & Rows.Count).End(xlUp))
            If h.Value <> "" Then ComboBox9.AddItem h.Value
        Next h
    End With
    
    
    
    
End With
 
End Sub


Private Sub CommandButton1_Click()
 
Dim emptyRow As Long
 
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1


Cells(emptyRow, 1).Value = DTPicker1.Value
Cells(emptyRow, 2).Value = TextBox1.Value
Cells(emptyRow, 3).Value = ComboBox4.Value
Cells(emptyRow, 4).Value = TextBox3.Value
Cells(emptyRow, 5).Value = DTPicker2.Value
Cells(emptyRow, 6).Value = ComboBox1.Value
Cells(emptyRow, 7).Value = TextBox4.Value
Cells(emptyRow, 8).Value = TextBox5.Value
Cells(emptyRow, 9).Value = TextBox6.Value
Cells(emptyRow, 10).Value = TextBox7.Value
Cells(emptyRow, 11).Value = TextBox8.Value
Cells(emptyRow, 12).Value = ComboBox5.Value
Cells(emptyRow, 13).Value = TextBox10.Value
Cells(emptyRow, 14).Value = TextBox13.Value
Cells(emptyRow, 15).Value = ComboBox2.Value
Cells(emptyRow, 16).Value = ComboBox6.Value
Cells(emptyRow, 17).Value = TextBox14.Value
Cells(emptyRow, 18).Value = ComboBox7.Value
Cells(emptyRow, 19).Value = TextBox15.Value
Cells(emptyRow, 20).Value = ComboBox8.Value
Cells(emptyRow, 21).Value = TextBox16.Value


Dim answer As Integer


answer = MsgBox("Are you sure you want to clear the form?", vbYesNo + vbQuestion, "Clear form")
If answer = vbYes Then
     
   Dim z As Control
 For Each z In UserForm1.Controls
 If TypeName(z) = "TextBox" Then
 z.Value = ""
 End If
 Next z
Call UserForm_Initialize
Else
     'do nothing
End If
End Sub

Display More

**royUK** · Apr 26th 2016

Re: Can someone please shorten this VBA code for me? For a userform

Please read the Forum Rules before postingg again and use Code Tags when posting code

Code

Private Sub UserForm_Initialize()
    Dim c As Range


    With Me
        .ComboBox8.List = Array("No", "Yes")
        .DTPicker1.SetFocus
        .ComboBox4.List = Array("Patron", "Staff", "Contractor")


        With Sheets("Lists")
            For Each c In .Range("C:C", .Range("C" & Rows.Count).End(xlUp))
                If c.Value <> "" Then Me.ComboBox3.AddItem c.Value
            Next c
        End With




        .ComboBox1.List = Array("Male", "Female")
        .ComboBox5.List = Array("Front", "Back", "Both")


        With Sheets("Lists")
            For Each c In .Range("E:E", .Range("E" & Rows.Count).End(xlUp))
                If c.Value <> "" Then Me.ComboBox6.AddItem c.Value
            Next c
        End With


    End With


    With Sheets("Lists")
        For Each c In .Range("D:D", .Range("D" & Rows.Count).End(xlUp))
            If c.Value <> "" Then Me.ComboBox2.AddItem c.Value
        Next c
    End With


    With Sheets("Lists")
        For Each c In .Range("G:G", .Range("G" & Rows.Count).End(xlUp))
            If c.Value <> "" Then Me.ComboBox7.AddItem f.Value
        Next c
    End With


    With Sheets("Lists")
        For Each c In .Range("J:J", .Range("J" & Rows.Count).End(xlUp))
            If c.Value <> "" Then Me.ComboBox9.AddItem c.Value
        Next c
    End With


End Sub


Private Sub CommandButton1_Click()
    Dim iX As Integer
    Dim emptyRow As Long
    Dim answer As Integer


    emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1




    Cells(emptyRow, 1).Value = DTPicker1.Value
    Cells(emptyRow, 2).Value = TextBox1.Value
    Cells(emptyRow, 3).Value = ComboBox4.Value
    Cells(emptyRow, 4).Value = TextBox3.Value
    Cells(emptyRow, 5).Value = DTPicker2.Value
    Cells(emptyRow, 6).Value = ComboBox1.Value
    Cells(emptyRow, 7).Value = TextBox4.Value
    Cells(emptyRow, 8).Value = TextBox5.Value
    Cells(emptyRow, 9).Value = TextBox6.Value
    Cells(emptyRow, 10).Value = TextBox7.Value
    Cells(emptyRow, 11).Value = TextBox8.Value
    Cells(emptyRow, 12).Value = ComboBox5.Value
    Cells(emptyRow, 13).Value = TextBox10.Value
    Cells(emptyRow, 14).Value = TextBox13.Value
    Cells(emptyRow, 15).Value = ComboBox2.Value
    Cells(emptyRow, 16).Value = ComboBox6.Value
    Cells(emptyRow, 17).Value = TextBox14.Value
    Cells(emptyRow, 18).Value = ComboBox7.Value
    Cells(emptyRow, 19).Value = TextBox15.Value
    Cells(emptyRow, 20).Value = ComboBox8.Value
    Cells(emptyRow, 21).Value = TextBox16.Value




    answer = MsgBox("Are you sure you want to clear the form?", vbYesNo + vbQuestion, "Clear form")
    If answer = vbYes Then UserForm_Initialize
End Sub

Display More

jbalth · Apr 26th 2016

Re: Can someone please shorten this VBA code for me? For a userform

Thankyou! Unfortunately, I'm getting an object required error.

Any idea?

jbalth · Apr 26th 2016

Re: Can someone please shorten this VBA code for me? For a userform

All good found it!

Code

Each c In .Range("G:G", .Range("G" & Rows.Count).End(xlUp)) 
            If c.Value <> "" Then Me.ComboBox7.AddItem f.Value

Type. Should be c instead of f. obviously missed the keyboard by a fraction!

Thanks

[COLOR="#FF0000"]Moderation Edit : please remember to add code tags to your VBA code[/COLOR]

**royUK** · Apr 26th 2016

Re: Can someone please shorten this VBA code for me? For a userform

Missed that sorry.

apo · Apr 26th 2016

Re: Can someone please shorten this VBA code for me? For a userform

Just a thought...

Maybe also the part where you populate the sheet could be shortened, code wise..(but not necessarily sped up)....

Something like : (pseudo code)...

Code

For I = 1 To 21
         Cells(emptyRow, I).Value =  Choose(I, DTPicker1.Value, TextBox1.Value, etc etc)
Next i

**royUK** · Apr 27th 2016

Re: Can someone please shorten this VBA code for me? For a userform

You can use an array to write to the sheet

Code

Dim emptyrow As Long
    emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
    With Me
        Range(Cells(emptyrow, 11), Cells(emptyrow, 3)).Value = _
        Array(.DTPicker1.Value, .TextBox1.Value, .ComboBox4.Value, .TextBox3.Value, _
              .DTPicker2.Value, .ComboBox1.Value, .TextBox4.Value, .TextBox5.Value, _
              .TextBox6.Value, .TextBox7.Value, .TextBox8.Value, .ComboBox5.Value, _
              .TextBox10.Value, .TextBox13.Value, ComboBox2.Value, .ComboBox6.Value, _
              .TextBox14.Value, .ComboBox2.Value, .ComboBox7.Value, TextBox15.Value, _
              .ComboBox8.Value, .TextBox16.Value)
    End With

Display More

Can someone please shorten this VBA code for me? For a userform

Participate now!

Share