Save button

[Rvittur]

Following my last issue, which is solved. How can i get the save button on my userform to repeat the actions. Basically once all my selections are made, I click save to transfer the data to where it needs to go. however if i was to just start adding new selections i start getting errors. To avoid this i have to click exit and reclick the userform button.

this is the code i use on the save button

Private Sub cmdSave_Click()

Application.ScreenUpdating = False

Dim sch As Variant
Dim lRow As Long
Dim wsp As Worksheet
Dim wsp1 As Worksheet
Set wsp = Worksheets("Pickup")



lRow = wsp.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row

If cmdDate.Value >= "3/20" And cmdDate.Value <= "3/26" Then 'must be text
cmdSave_Click2
Call cmdSave_Click2

ElseIf cmdDate.Value >= "3/27" And cmdDate.Value <= "4/2" Then 'must be text
cmdSave_Click3
Call cmdSave_Click3

End If

''''Clear input''''
UserForm1.CmdEmployeeName.Value = ""
UserForm1.cmdDate.Value = ""
UserForm1.cmdTimeStart.Value = ""
UserForm1.cmdSuitDown.Value = ""
UserForm1.txtNotes.Value = ""
UserForm1.cmdDLRFLR.Value = ""
UserForm1.cmdTSC.Value = ""



MsgBox "Pickup Added", vbInformation



Application.ScreenUpdating = True


End Sub

Module1 hold the first round of codes needed for the 1st range of Dates.

Application.ScreenUpdating = False
Dim lRow As Long
Dim mRow As Long, mrow1 As Long, trow As Long, trow1 As Long, wrow As Long, wrow1 As Long, throw As Long, throw1 As Long, frow As Long, frow1 As Long, srow As Long, srow1 As Long, surow As Long, surow1 As Long
Dim wb1 As Workbook
Set wb1 = Workbooks("Pickup Form TestList")
Dim ws As Worksheet
Set ws = wb1.Worksheets("Pickup")

Dim wb As Workbook
Dim ws1 As Worksheet
Set wb = Workbooks.Open("C:\Users\jvittur\OneDrive\Desktop\Schedules\Sched Pickup 03.26.xlsm")
Set ws1 = wb.Worksheets("RoadMap")
Dim f As Range

lRow = ws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
mRow = ws1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
mrow1 = ws1.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
trow = ws1.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Row
trow1 = ws1.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
wrow = ws1.Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).Row
wrow1 = ws1.Cells(Rows.Count, 14).End(xlUp).Offset(1, 0).Row
throw = ws1.Cells(Rows.Count, 18).End(xlUp).Offset(1, 0).Row
throw1 = ws1.Cells(Rows.Count, 19).End(xlUp).Offset(1, 0).Row
frow = ws1.Cells(Rows.Count, 23).End(xlUp).Offset(1, 0).Row
frow1 = ws1.Cells(Rows.Count, 24).End(xlUp).Offset(1, 0).Row
srow = ws1.Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
srow1 = ws1.Cells(Rows.Count, 29).End(xlUp).Offset(1, 0).Row
surow = ws1.Cells(Rows.Count, 33).End(xlUp).Offset(1, 0).Row
surow1 = ws1.Cells(Rows.Count, 34).End(xlUp).Offset(1, 0).Row

With ws

.Cells(lRow, 2).Value = UserForm1.CmdEmployeeName.Value
.Cells(lRow, 3).Value = UserForm1.cmdDate.Value
.Cells(lRow, 1).Value = UserForm1.cmdTimeStart.Value
.Cells(lRow, 5).Value = UserForm1.cmdSuitDown.Value
.Cells(lRow, 7).Value = UserForm1.txtNotes.Value
.Cells(lRow, 4).Value = UserForm1.cmdDLRFLR.Value
.Cells(lRow, 6).Value = UserForm1.cmdTSC.Value
.Cells(lRow, 8).Value = UserForm1.TextBox1.Text

End With

If UserForm1.cmdSuitDown.Value <> "" And UserForm1.cmdTSC.Value <> "" And UserForm1.cmdDate = "3/20" Then
Set f = ws1.Range("D:D").Find(UserForm1.cmdSuitDown, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
ws1.Range("C" & f.Row).Value = UserForm1.cmdTSC.Value
f.Interior.Color = vbYellow
End If
End If

If UserForm1.cmdDate.Value = "3/20" Then
wb.Worksheets("Roadmap").Activate
ws1.Cells(mRow, 3).Value = UserForm1.cmdTimeStart.Value
ws1.Cells(mrow1, 4).Value = UserForm1.CmdEmployeeName.Value

End If

With UserForm1
ws.Cells(lRow, 5).Value = UserForm1.cmdSuitDown.Value
ws.Cells(lRow, 3).Value = UserForm1.cmdDate.Value
End With
If UserForm1.cmdSuitDown.Value <> "" And UserForm1.cmdTSC.Value <> "" And UserForm1.cmdDate = "3/21" Then
Set f = ws1.Range("I:I").Find(UserForm1.cmdSuitDown, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
ws1.Range("H" & f.Row).Value = UserForm1.cmdTSC.Value
f.Interior.Color = vbYellow
End If
End If

''''more code of repeat'''

''''Clear input''''
UserForm1.CmdEmployeeName.Value = ""
UserForm1.cmdDate.Value = ""
UserForm1.cmdTimeStart.Value = ""
UserForm1.cmdSuitDown.Value = ""
UserForm1.txtNotes.Value = ""
UserForm1.cmdDLRFLR.Value = ""
UserForm1.cmdTSC.Value = ""

Application.Windows("Sched Pickup "".xlsm").Visible = True

Application.ScreenUpdating = True

End Sub

Other code is on Date change since on combobox is based on its selection, where i get the errors at as well as on the UserForm Initialize
Private Sub UserForm_Initialize()

UserForm1.cmdSuitDown.List = Range("Monday").Value
UserForm1.CmdEmployeeName.List = Range("EmployeeName").Value
UserForm1.cmdDLRFLR.List = Range("DLRFLR").Value
UserForm1.cmdDate.List = Range("Date").Value
UserForm1.cmdTimeStart.List = Range("TimeStart").Value
UserForm1.cmdTSC.List = Range("TSC").Value

TextBox1.Value = Now
TextBox1 = Format(TextBox1.Value, "dd mmmm yyyy hh:mm")

End Sub


Private Sub cmdDate_Change()

With UserForm1.cmdDate.Value

If UserForm1.cmdDate.Value = "3/20" Then 'Monday
UserForm1.cmdSuitDown.List = Range("Monday").Offset(0, UserForm1.cmdDate.ListIndex).Value
ElseIf UserForm1.cmdDate.Value = "3/21" Then 'Tues
UserForm1.cmdSuitDown.List = Range("Monday").Offset(0, UserForm1.cmdDate.ListIndex + 4).Value

''''repeat of code with changes'''
ElseIf UserForm1.cmdDate.Value = "4/02" Then 'Sun
UserForm1.cmdSuitDown.Value = ""
UserForm1.cmdSuitDown.List = Range("Monday1").Offset(0, UserForm1.cmdDate.ListIndex + 17).Value

End If
End With
End If
End Sub

Would appreciate any advice or help

Thank You

 

[Bill Rockenbach]

If cmdDate.Value >= "3/20" And cmdDate.Value <= "3/26" Then 'must be text
cmdSave_Click2
Call cmdSave_Click2

Why are you calling "cmdSave_Click2" twice in a row.

What line of code fails and what is the error description

You have a sub routine listed without the sub name included

 

[Rvittur]

If cmdDate.Value >= "3/20" And cmdDate.Value <= "3/26" Then 'must be text
cmdSave_Click2
Call cmdSave_Click2

Why are you calling "cmdSave_Click2" twice in a row.

What line of code fails and what is the error description

You have a sub routine listed without the sub name included

sorry that would be Public Sub cmdSave_Click2()

method of object global fail

Private Sub cmdDate_Change()

With UserForm1.cmdDate.Value

If UserForm1.cmdDate.Value = "3/20" Then 'Monday
UserForm1.cmdSuitDown.List = Range("Monday").Offset(0, UserForm1.cmdDate.ListIndex).Value <-------Highlights
ElseIf UserForm1.cmdDate.Value = "3/21" Then 'Tues

Range("Monday") is linked to another workbook

 

[Bill Rockenbach]

Rvittur, can you step through the code and get the exact line that fails. "method of object global fail" usually means a line of code is failing to access an object.

 

[Rvittur]

See previous post where it has <----highlight is where it shows the error code

 

[Rvittur]

See previous post where it has <----highlight is where it shows the error code

I found the issue lmao..was with setting the workbook and worksheet lol

 

[smozgur]

I found the issue lmao..was with setting the workbook and worksheet lol

Good to hear you found the issue.
If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

 

[Rvittur]

Private Sub cmdSave_Click()

Application.ScreenUpdating = False
Dim wbp As Workbook
Set wbp = Workbooks("Pickup Form.xlsm")
Dim sch As Variant
Dim lRow As Long
Dim wsp As Worksheet
Dim wsp1 As Worksheet
Set wsp = wbp.Worksheets("Pickup") 'had to add the wbp.worksheets for it to work with the rest of code

lRow = wsp.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row '''finds last row of Pickup sheet

If cmdDate.Value >= "3/20" And cmdDate.Value <= "3/26" Then 'Date must be text. Due to named ranges code must be in module
Call cmdSave_Click2

ElseIf cmdDate.Value >= "3/27" And cmdDate.Value <= "4/2" Then 'Date must be text. Due to named ranges code must be in module
Call cmdSave_Click3

End If

''''Clear input''''
UserForm1.CmdEmployeeName.Value = ""
UserForm1.cmdDate.Value = ""
UserForm1.cmdTimeStart.Value = ""
UserForm1.cmdSuitDown.Value = ""
UserForm1.txtNotes.Value = ""
UserForm1.cmdDLRFLR.Value = ""
UserForm1.cmdTSC.Value = ""

MsgBox "Pickup Added", vbInformation

Application.ScreenUpdating = True

End Sub