VBA: Can you help me make this code more efficient?

Peter h

Active Member
Joined
Dec 8, 2015
Messages
417
I've got a scheduling workbook for my employees. It works good, and does exactly what I want, but I know there is a way to make the code more efficient, and I'm not exactly sure how to do it. I'll explain the workbook a little bit before I show the code. I have 12 sheets (1 for each month), that has each employees schedule. These sheets are locked and cannot be changed. I use formulas on these sheets that make these sheets show data that is entered to 2 hidden sheets (1 is "MASTERPTO" in the code) via a userform. So, if an employee requests PTO on Jan. 1, the userform put PTO on the hidden sheet, and the "Jan" worksheet shows that change. The way I have it set up, if that employee is on the "Jan" Worksheet and clicks on the cell associated with Jan. 1, the userform pops up with a textbox automatically populated with the date the employee clicked on.

Code:
Private Sub UserForm_Initialize()

    TextBox1.Text = ActiveSheet.Cells.Range("A" & (ActiveCell.Row)).Value
    
End Sub

Well, when the "Submit" button is clicked it puts the data entered in the userform on my hidden sheet. The hidden sheet has the dates Jan 1 - Dec 31 in Column "A", starting in row 2. I wanted it to find whatever date was in TextBox1 on that list and use that row to enter whatever data is entered, but it isn't finding the date. I think it has something to do with I used formulas to make the list rather than actual text. So A2 = 01/01/2017, A3 = A2 + 1, A4 = A3 + 1, etc... Here's my code:

Code:
Private Sub SUBMIT_Click()
Dim Wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim lastrow As Long
Set Wb = ThisWorkbook
Set ws = Wb.Sheets("MASTERPTO")
Set rng1 = ws.Range("A:A").Find(UserForm1.TextBox1.Value, ws.[a1], xlValues, xlWhole, xlByRows, xlNext)
    If Not rng1 Is Nothing Then
    If MsgBox("Once submitted, all data will be locked, and can only be changed by the supervisor." & vbCrLf & "Please make sure all info is correct" & vbCrLf & "Click Yes to confirm entry, or No to Cancel", vbYesNo) = vbNo Then Exit Sub
    If ws.Cells(rng1 - 42734, CBREQUSTR.ListIndex + 2).Value = "" Then
        ws.Cells(rng1 - 42734, CBREQUSTR.ListIndex + 2).Value = CBPTO.Text
    ElseIf ws.Cells(rng1 - 42734, CBREQUSTR.ListIndex + 2).Value = "" = False Then
        MsgBox ("That cell already has data entered.")
        Exit Sub
    End If
    End If
    
    ws.Cells(rng1 - 42734, CBREQUSTR.ListIndex + 2).Value = CBPTO.Text
    If ws.Cells(rng1 - 42734, 15).Value = "" Then
        ws.Cells(rng1 - 42734, 15).Value = CBREQUSTR.Text & " " & TextBox1.Text & " " & CBPTO.Text & " was requested on " & Now
    ElseIf ws.Cells(rng1 - 42734, 15).Value = "" = False Then
        ws.Cells(rng1 - 42734, 16).Value = CBREQUSTR.Text & " " & TextBox1.Text & " " & CBPTO.Text & " was requested on " & Now
    End If
      
   ActiveWorkbook.Save
   Unload UserForm1
        
End Sub

rng1 is supposed to find whatever date is in TextBox1, but it's using that date and going to the row number of the number code of the date in TextBox1. So I had to subtract 42734 from rng1 to get it on the right row. Next year when I do the schedule for 2018, I'll have to subtract 43099 from rng 1. How do I get it to just find the row with the matching date in "A"?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Working with dates can be troublesome. You have to make sure they are the same data types when doing Find, Match, Search, equal or not equal. you can try forcing them to the same data type like this;
Code:
Set rng1 = ws.Range("A:A").Find([COLOR=#FF8C00]CDate[/COLOR](UserForm1.TextBox1.Value), ws.[a1], xlValues, xlWhole, xlByRows, xlNext)
 
Upvote 0
I've been beaten to it by both the above but as I have actually prepared the amended code, here it is..

Code:
Private Sub SUBMIT_Click()
Dim Wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim lastrow As Long
Set Wb = ThisWorkbook
Set ws = Wb.Sheets("MASTERPTO")
Set rng1 = ws.Range("A:A").Find(CDate(UserForm1.TextBox1.Value), ws.[a1], xlValues, xlWhole, xlByRows, xlNext)
    If Not rng1 Is Nothing Then


    If MsgBox("Once submitted, all data will be locked, and can only be changed by the supervisor." & vbCrLf & "Please make sure all info is correct" & vbCrLf & "Click Yes to confirm entry, or No to Cancel", vbYesNo) = vbNo Then Exit Sub
    If ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = "" Then
        ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = CBPTO.Text
    ElseIf ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = "" = False Then
        MsgBox ("That cell already has data entered.")
        Exit Sub
    End If
    End If
    
    ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = CBPTO.Text
    If ws.Cells(rng1.Row, 15).Value = "" Then
        ws.Cells(rng1.Row, 15).Value = CBREQUSTR.Text & " " & TextBox1.Text & " " & CBPTO.Text & " was requested on " & Now
    ElseIf ws.Cells(rng1.Row, 15).Value = "" = False Then
        ws.Cells(rng1row, 16).Value = CBREQUSTR.Text & " " & TextBox1.Text & " " & CBPTO.Text & " was requested on " & Now
    End If
      
   ActiveWorkbook.Save
   Unload UserForm1
        
End Sub

Your textbox string was not going to match a find in a date column without you convert with date.
 
Upvote 0
No prob, i was very tempted to type lol... dont worry we all do it... the easiest problems can sometimes be the hardest xD
 
Last edited:
Upvote 0
Working with dates can be troublesome. You have to make sure they are the same data types when doing Find, Match, Search, equal or not equal. you can try forcing them to the same data type like this;
Code:
Set rng1 = ws.Range("A:A").Find([COLOR=#ff8c00]CDate[/COLOR](UserForm1.TextBox1.Value), ws.[a1], xlValues, xlWhole, xlByRows, xlNext)

I've been beaten to it by both the above but as I have actually prepared the amended code, here it is..

Rich (BB code):
Private Sub SUBMIT_Click()
Dim Wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim lastrow As Long
Set Wb = ThisWorkbook
Set ws = Wb.Sheets("MASTERPTO")
Set rng1 = ws.Range("A:A").Find(CDate(UserForm1.TextBox1.Value), ws.[a1], xlValues, xlWhole, xlByRows, xlNext)
    If Not rng1 Is Nothing Then


    If MsgBox("Once submitted, all data will be locked, and can only be changed by the supervisor." & vbCrLf & "Please make sure all info is correct" & vbCrLf & "Click Yes to confirm entry, or No to Cancel", vbYesNo) = vbNo Then Exit Sub
    If ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = "" Then
        ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = CBPTO.Text
    ElseIf ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = "" = False Then
        MsgBox ("That cell already has data entered.")
        Exit Sub
    End If
    End If
    
    ws.Cells(rng1.Row, CBREQUSTR.ListIndex + 2).Value = CBPTO.Text
    If ws.Cells(rng1.Row, 15).Value = "" Then
        ws.Cells(rng1.Row, 15).Value = CBREQUSTR.Text & " " & TextBox1.Text & " " & CBPTO.Text & " was requested on " & Now
    ElseIf ws.Cells(rng1.Row, 15).Value = "" = False Then
        ws.Cells(rng1row, 16).Value = CBREQUSTR.Text & " " & TextBox1.Text & " " & CBPTO.Text & " was requested on " & Now
    End If
      
   ActiveWorkbook.Save
   Unload UserForm1
        
End Sub

Your textbox string was not going to match a find in a date column without you convert with date.

I actually didn't have to add the "CDate" to the code. Just adding the ".Row" part solved the issue. Thanks for the help and the replies guys. I appreciate it.
 
Upvote 0
OMG, I don't know how I missed that. I think that solved my issue. I don't know why when I wrote the code I didn't put the .Row... I feel dumb now. Thanks for the help.

Yep, me too! I zeroed in on the dates because they are such a pain in the neck if not properely used in code. Good analysis cerfani.
 
Upvote 0
I have seen so much vba code and i have never seen so many 40000s being used to reference rows, i just knew something was odd about it on first glance lol... i guess that's why i looked there first
 
Upvote 0
Ya, this code was one of my very first projects, and that's the way I got it to work at the time. I'm more experience and familiar with the coding now, so decided to go back through the code, and still couldn't figure out how to do it. lol.
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,195
Members
453,021
Latest member
pingpong7117

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