VBA Simplification Help for Userform

B

Ben85

New Member
Joined
Jan 9, 2017
Messages
30
I am trying to see about simplifying my code. I was thinking if it was possible to do a loop it would be much easier, but I am not sure if it is... Any help would be appreciated.

What I was thinking about if even possible...
Code: 
Dim I  As Integer
i = 1

Do Until i = 8
      label_ & i = Range("c_form" & i).Text
      tb_f & i .Text = "0.0000"
      i = i +1
Loop

Here is my current actual code. For the Userform activation
Code: 
Private Sub UserForm_Activate()
    Dim PW As String
    Dim USER As String
    Dim i As Integer
    
    'Labels based off names of forms from table
    label_1 = Range("c_form1").Text
    label_2 = Range("c_form2").Text
    label_3 = Range("c_form3").Text
    label_4 = Range("c_form4").Text
    label_5 = Range("c_form5").Text
    label_6 = Range("c_form6").Text
    label_7 = Range("c_form7").Text
    label_8 = Range("c_form8").Text


    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    
    'Load Forms "Master" Values from worksheet
    F1m = Range("c_f1m")
    F2m = Range("c_f2m")
    F3m = Range("c_f3m")
    F4m = Range("c_f4m")
    F5m = Range("c_f5m")
    F6m = Range("c_f6m")
    F7m = Range("c_f7m")
    F8m = Range("c_f8m")
    
    'Populate text boxes.
    tb_User = USER
    tb_date = Format(Now, "mm/dd/yy h:mm am/PM")
    tb_f1.Text = "0.0000"
    tb_f2.Text = "0.0000"
    tb_f3.Text = "0.0000"
    tb_f4.Text = "0.0000"
    tb_f5.Text = "0.0000"
    tb_f6.Text = "0.0000"
    tb_f7.Text = "0.0000"
    tb_f8.Text = "0.0000"
    
    tb_f1m = Format(F1m, "0.0000")
    tb_f2m = Format(F2m, "0.0000")
    tb_f3m = Format(F3m, "0.0000")
    tb_f4m = Format(F4m, "0.0000")
    tb_f5m = Format(F5m, "0.0000")
    tb_f6m = Format(F6m, "0.0000")
    tb_f7m = Format(F7m, "0.0000")
    tb_f8m = Format(F8m, "0.0000")
    
    tb_f1.SetFocus
    tb_notes = ""
End Sub

As well as my code for when the Accept button on the UserForm is clicked.
Code: 
Private Sub btn_accept_Click()
    Dim PW As String
    Dim USER As String
    Dim ConfirmPW As String
    Dim ProtPW As String
    Dim LastRow As Long
    Dim NewRow As Long
    Dim Ref As Range
    
    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    ProtPW = Range("c_pass").Text


    If tb_f1.Value = 0 And tb_f2.Value = 0 And tb_f3.Value = 0 And tb_f4.Value = 0 And _
        tb_f5.Value = 0 And tb_f6.Value = 0 And tb_f7.Value = 0 And tb_f8.Value = 0 Then
        If MsgBox("No changes made. Continue?", vbOKCancel) = vbCancel Then
            Unload Me
            Exit Sub
        End If
    End If
    
    If tb_f1.Value = "" Or tb_f2.Value = "" Or tb_f3.Value = "" Or tb_f4.Value = "" _
        Or tb_f5.Value = "" Or tb_f6.Value = "" Or tb_f7.Value = "" Or tb_f8.Value = "" Then
        MsgBox ("Cannot leave a entry BLANK. (Zero is acceptable.)")
            Exit Sub
    End If
    
    ConfirmPW = InputBox("Confirm Password for current user (" & USER & ").", "Password")
        If ConfirmPW = PW Then
            'If Password checks good then all entries will be loaded.
            'Determine emptyRow
            'LastRow = DieDim.Range("A3").End(xlDown).Offset(1, 0).Select
            NewRow = Application.WorksheetFunction.CountA(Range("A:A")) + 2
            LastRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
            
            'Unprotect Worksheet.
            If Range("c_admin") = False Then
                DieDim.Unprotect ProtPW
            End If


            'Transfer information
            'Increment# entry
            If Cells(LastRow, 1).Value = "MASTER" Then
                Cells(NewRow, 1) = 1
            Else
                Cells(NewRow, 1) = Cells(LastRow, 1).Value + 1
            End If
            
            'Add Date to row
            Cells(NewRow, 2) = Format(Now, "mm/dd/yy h:mm am/PM")
            'Add Employee# to row
            Cells(NewRow, 3) = tb_User.Text
            'Tranfer Form1
            Set Ref = Cells(NewRow, 4)
                If tb_f1.Value = 0 Or tb_f1m.Value Then
                    Ref.Value = Cells(LastRow, 4).Value
                Else
                    Ref.Value = tb_f1.Value
                    Ref.Interior.ColorIndex = 19 'Colors: 19=LightYellow, 20=LightBlue, 35=LightGreen
                End If
            'Tranfer Form2
            Set Ref = Cells(NewRow, 5)
                If tb_f2.Value = 0 Or tb_f2m.Value Then
                    Ref.Value = Cells(LastRow, 5).Value
                Else
                    Ref.Value = tb_f2.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form3
            Set Ref = Cells(NewRow, 6)
                If tb_f3.Value = 0 Or tb_f3m.Value Then
                    Ref.Value = Cells(LastRow, 6).Value
                Else
                    Ref.Value = tb_f3.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form4
            Set Ref = Cells(NewRow, 7)
                If tb_f4.Value = 0 Or tb_f4m.Value Then
                    Ref.Value = Cells(LastRow, 7).Value
                Else
                    Ref.Value = tb_f4.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form5
            Set Ref = Cells(NewRow, 8)
                If tb_f5.Value = 0 Or tb_f5m.Value Then
                    Ref.Value = Cells(LastRow, 8).Value
                Else
                    Ref.Value = tb_f5.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form6
            Set Ref = Cells(NewRow, 9)
                If tb_f6.Value = 0 Or tb_f6m.Value Then
                    Ref.Value = Cells(LastRow, 9).Value
                Else
                    Ref.Value = tb_f6.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form7
            Set Ref = Cells(NewRow, 10)
                If tb_f7.Value = 0 Or tb_f7m.Value Then
                    Ref.Value = Cells(LastRow, 10).Value
                Else
                    Ref.Value = tb_f7.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form8
            Set Ref = Cells(NewRow, 11)
                If tb_f8.Value = 0 Or tb_f8m.Value Then
                    Ref.Value = Cells(LastRow, 11).Value
                Else
                    Ref.Value = tb_f8.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Transfer NOTES
            Cells(NewRow, 12) = tb_notes.Text
            Unload Me


            'Protect Worksheet if not admin.
            If Range("c_admin") = False Then
                DieDim.Protect ProtPW
            End If
            ActiveWorkbook.Save
            Unload Me
        Else
            'Bad password entry. Cancels Data Entry.
            MsgBox ("Password incorrect. Data Entry Rejected.")
            Unload Me
        End If
End Sub

I am sure my code will get laughed at, but I would love some help cleaning it up and simplifying it a bit!
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
You can use the Controls collection of the userform.
Code: 
For I = 1 To 8
    Me.Controls("label_" & I) = Range("c_form" & i).Text
    Me.Controls("tb_f" & I).Text = "0.0000"      
Next I
 
Upvote 0
Norie said:
You can use the Controls collection of the userform.
Code: 
For I = 1 To 8
    Me.Controls("label_" & I) = Range("c_form" & i).Text
    Me.Controls("tb_f" & I).Text = "0.0000"      
Next I
Click to expand...

Thank you Norie! That did help me clean up my code quite a bit, and I made some changes to hopefully simplify when I need to make additions in the future.

Here is my new code.
Code: 
Option Explicit
Public NumberOfForms As Byte
Public i As Byte

Private Sub UserForm_Activate()    Dim PW As String
    Dim USER As String


    NumberOfForms = 8
    
    For i = 1 To NumberOfForms
    'Pull labels based off form names.
        Me.Controls("label_" & i) = Range("c_form" & i).Text
    'Pulls MASTER dimensions for forms.
        Me.Controls("tb_fm" & i) = Format(Range("c_fm" & i), "0.0000")
    Next i


    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    
    'Populate text boxes.
    tb_User = USER
    tb_date = Format(Now, "mm/dd/yy h:mm am/PM")
    
    tb_f1.SetFocus
    tb_notes = ""
End Sub

Code: 
Private Sub btn_accept_Click()    Dim PW As String
    Dim USER As String
    Dim ConfirmPW As String
    Dim ProtPW As String
    Dim LastRow As Long
    Dim NewRow As Long
    Dim Ref As Range
    Dim RefLast As Range
    Dim cnt As Byte
    Dim UserFormEntry
    
    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    ProtPW = Range("c_pass").Text


    cnt = 1
    For i = 1 To NumberOfForms
        Me.Controls("tb_f" & i) = Format(Me.Controls("tb_f" & i), "0.0000")
        
        If Me.Controls("tb_f" & i).Value = 0 Then
            cnt = cnt + 1
        End If
        
        If Me.Controls("tb_f" & i).Value = "" Then
            MsgBox ("Cannot Leave an entry BLANK. (Zero is acceptable.)")
            Exit Sub
        End If
    Next i
    
    If cnt = i Then
        If MsgBox("No changes made. Continue?", vbOKCancel) = vbCancel Then
            Unload Me
            Exit Sub
        End If
    End If
    
    ConfirmPW = InputBox("Confirm Password for current user (" & USER & ").", "Password")
        If ConfirmPW = PW Then
            'If Password checks good then all entries will be loaded.
            NewRow = Application.WorksheetFunction.CountA(Range("A:A")) + 2
            LastRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
            
            'Unprotect Worksheet.
            If Range("c_admin") = False Then
                DieDim.Unprotect ProtPW
            End If


            'Transfer information
            'Increment# entry
            If Cells(LastRow, 1).Value = "MASTER" Then
                Cells(NewRow, 1) = 1
                Else
                    Cells(NewRow, 1) = Cells(LastRow, 1).Value + 1
            End If
            
            'Add Date to row
            Cells(NewRow, 2) = Format(Now, "mm/dd/yy h:mm am/PM")
            
            'Add Employee# to row
            Cells(NewRow, 3) = tb_User.Text
            
            'Transfer Userform dim entries.
            For i = 1 To NumberOfForms
                Set Ref = Cells(NewRow, i + 3)
                Set RefLast = Cells(LastRow, i + 3)
                RefLast = Format(RefLast, "0.0000")
                    If Me.Controls("tb_f" & i).Value = 0 Or Me.Controls("tb_f" & i) = RefLast Then
                        Ref.Value = Cells(LastRow, i + 3).Value
                        Else
                        Ref.Value = Me.Controls("tb_f" & i).Value
                        Ref.Interior.ColorIndex = 19 '(Yellow Fill) 'Colors: 19=LightYellow, 20=LightBlue, 35=LightGreen
                    End If
            Next i
            
            'Transfer NOTES
            Cells(NewRow, NumberOfForms + 4) = tb_notes.Text
            Unload Me


            'Protect Worksheet if not admin.
            If Range("c_admin") = False Then
                DieDim.Protect ProtPW
            End If
            ActiveWorkbook.Save
            Unload Me
            Else
            'Bad password entry. Cancels Data Entry.
            MsgBox ("Password incorrect. Data Entry Rejected.")
            Unload Me
        End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Can someone help me with VBA code to split cell info into new row
Replies
6
Views
1K
Liverlee
L
K
  • Question
Comparing two sheets
Replies
3
Views
845
Killragtshirts
K
J
  • Question
VBA solution for asset tracker
Replies
4
Views
370
jhod917
J
J
  • Question
Check if any values are already in the established FirstRow
Replies
9
Views
300
NoSparks
N
F
  • Solved
Problems filtering a Pivot Table with VBA
Replies
2
Views
153
Domenic
D

Forum statistics

Threads
1,214,424
Messages
6,119,401
Members
448,893
Latest member
AtariBaby

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top