Sub submit2016(ByVal df1 As Integer)
Stop
Dim ui1 As String
Dim lrow_rd, drow_rd As Integer
Dim grp_flg As Integer
Dim pn As Long, mr_tr As Long
Dim rng_pn As Range
Dim bmsg As String, msg1 As String, msg2 As String
Dim esf As Integer
Dim temp_ws As Worksheet, r As Range
Dim rngMissing_All As Range
Dim red_range As Range, dfl_range As Range
Dim wb As Workbook, nm As String
Dim VBC As Object ' UserForm VBComponent
'Set temp_ws = wb_sched.Worksheets("temp_ws")
Set rng_pn = ws_rd.Range("A:A")
grp_flag = ws_vh.Range("B1").Value '1 = new record 0 = edit
If mri = 1 Then
group_1.TextBox1.Value = group_1.cb_mri.Value 'rental number
End If
pn = group_1.TextBox1.Value 'rental number
'ws_rd.Activate 'remove
consistency esf 'all fields complete ESF = 1 then data is missing
If esf = 1 Then
group_1.submit1.Enabled = True
group_1.submit1.BackColor = RGB(198, 241, 198)
Exit Sub 'consistency failure. Exit
End If
ui1 = MsgBox("Is the information complete & correct?" & Chr(13) & Chr(13) & "Select [YES] to continue with the current submission, or [NO] to review and make changes.", vbQuestion + vbYesNo, "CONFIRMATION")
If ui1 = vbNo Then
group_1.submit1.Enabled = True
Exit Sub
Else 'determine destination row number
With ws_rd
If grp_flag = 1 Or mri = 1 Then 'new group entry
lrow_rd = .Cells(.Rows.Count, "A").End(xlUp).Row 'rental_data - last row of current database
drow_rd = lrow_rd + 1 'rental_data - destination row for new entry
bmsg = "Rental no. " & pn & " successfully added and saved."
Else 'replace existing (edit) grp_flag = 0
drow_rd = Application.WorksheetFunction.Match(pn, rng_pn, 0) 'destination row = row of existing rental
'MsgBox "Replaces row: " & drow_rd
bmsg = "Rental no. " & pn & " successfully updated."
End If
End With
End If
'transfer field entries to rental database
With ws_rd
If .AutoFilterMode Then .AutoFilterMode = False
'ws_rd.Activate
.Cells(drow_rd, 1) = group_1.TextBox1.Value
.Cells(drow_rd, 2) = group_1.amm_no.Value
.Cells(drow_rd, 3) = group_1.ai_type.Value
.Cells(drow_rd, 4) = group_1.ai_event.Value
.Cells(drow_rd, 5) = group_1.ai_function.Value
.Cells(drow_rd, 6) = group_1.ai_league.Value
.Cells(drow_rd, 7) = group_1.ai_calibre.Value
.Cells(drow_rd, 8) = group_1.ai_division.Value
.Cells(drow_rd, 9) = group_1.ai_function.Value & group_1.ai_league.Value & group_1.ai_calibre.Value & group_1.ai_division.Value
.Cells(drow_rd, 10) = group_1.ci_affiliated.Value
.Cells(drow_rd, 11) = group_1.ci_name1.Value
.Cells(drow_rd, 12) = group_1.ci_tele1a.Value
If group_1.ai_type Like "D*" Then
.Cells(drow_rd, 17) = "YES" 'foul lines
Else
.Cells(drow_rd, 17) = "NO"
End If
.Cells(drow_rd, 13) = group_1.ai_basedist.Value
.Cells(drow_rd, 14) = group_1.ai_safety.Value
.Cells(drow_rd, 15) = group_1.ai_bbox.Value
.Cells(drow_rd, 16) = group_1.ai_safeline.Value
.Cells(drow_rd, 18) = group_1.ai_runline.Value
.Cells(drow_rd, 19) = group_1.ai_commit.Value
.Cells(drow_rd, 20) = group_1.ai_pitchdist.Value
.Cells(drow_rd, 21) = group_1.ai_circle.Value
.Cells(drow_rd, 22) = "NR"
.Cells(drow_rd, 23) = group_1.ai_mat.Value
.Cells(drow_rd, 24) = group_1.ai_other1.Value
.Cells(drow_rd, 25) = group_1.ai_other2.Value
.Cells(drow_rd, 26) = group_1.ai_layout.Value
.Cells(drow_rd, 27) = group_1.ai_goals.Value
.Cells(drow_rd, 28) = group_1.ai_other5.Value
.Cells(drow_rd, 29) = group_1.ai_other6.Value
.Cells(drow_rd, 30) = group_1.ai_setup.Value
.Cells(drow_rd, 31) = group_1.ai_other3.Value
.Cells(drow_rd, 32) = group_1.ai_other4.Value
.Cells(drow_rd, 33) = group_1.ai_water.Value
.Cells(drow_rd, 34) = group_1.ai_hydro.Value
.Cells(drow_rd, 35) = group_1.ai_attendance.Value
.Cells(drow_rd, 36) = group_1.ai_tables.Value
.Cells(drow_rd, 37) = group_1.ai_other7.Value
.Cells(drow_rd, 38) = group_1.ai_other8.Value
.Cells(drow_rd, 39) = group_1.ai_other9.Value
.Cells(drow_rd, 40) = group_1.ai_comment.Value
.Cells(drow_rd, 41) = format(group_1.date1.Value, "dd-mmm-yy") 'submission date
.Cells(drow_rd, 42) = group_1.ci_tele1b.Value
.Cells(drow_rd, 43) = group_1.ci_email1.Value
.Cells(drow_rd, 44) = group_1.ci_name2.Value
.Cells(drow_rd, 45) = group_1.ci_tele2a.Value
.Cells(drow_rd, 46) = group_1.ci_tele2a.Value
.Cells(drow_rd, 47) = group_1.ci_email2.Value
End With
'closing arguments (what happens after submission is made)
lastrow = ws_rd.Cells(ws_rd.Rows.Count, "A").End(xlUp).Row
ws_rd.Range("A3:FZ" & lastrow).Sort key1:=ws_rd.Range("A3"), Order1:=xlAscending, Header:=xlNo
drow_rd = Application.WorksheetFunction.Match(pn, rng_pn, 0) 'new record row location
group_1.Label34.Caption = " " & bmsg
group_1.Label34.BorderColor = RGB(50, 205, 50)
group_1.Caption = "USER GROUP [E" & drow_rd & "]"
Debug.Print ThisWorkbook.Name
ui1 = MsgBox("Save rental changes? {Sports17.xlsm}", vbYesNo, "TO BE REMOVED LATER")
'ui1 = vbYes
If ui1 = vbYes Then
Application.DisplayAlerts = False
Workbooks("Rental_Detail.xlsm").Save
Application.DisplayAlerts = True
End If
If InStr(bmsg, "updated") <> 0 Then
MsgBox "Rental " & pn & " successfulling updated and saved to rental database.", vbInformation, "CONFIRMATION"
Else
MsgBox "Rental " & pn & " successfulling added and saved to rental database.", vbInformation, "CONFIRMATION"
End If
If mri = 0 Then 'standard
'reset rental form to enter additional
Unload group_1
group_1.Show
Else 'ends rental entry unless more missing information exists
'update missing rental list; remove rental number from var_hold
With ws_vh.Range("L:M")
Set c = .Find(pn)
MsgBox pn & " found at: " & c.Address, , "Rental_Detail.xlsm [VAR_HOLD]"
c.Delete shift:=xlUp
End With
'update missing rental list; remove rental number from Temp1
With Workbooks("WATSOP19.xlsm").Worksheets("Temp1").Range("A:B")
Set c = .Find(pn)
MsgBox pn & " found at: " & c.Address, , "WATSOP19.xlsm [TEMP1]"
c.Delete shift:=xlUp
End With
'update data
'find data workbook
For Each wb In Application.Workbooks
If wb.Name Like "*Data.xlsx" Then
nm = wb.Name
Set ws_schedule = Workbooks(nm).Worksheets("Schedule")
End If
Next
'update schedule replacing #N/A with type
With ws_schedule
lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For rw = 2 To lrow
If IsError(.Cells(rw, 4)) Then
.Cells(rw, 4) = Application.WorksheetFunction.VLookup(pn, ws_rd.Range("A:C"), 3, False)
End If
Next rw
End With
'update type stats
Application.Run "WATSOP19.xlsm!cnt_type"
Set VBC = Workbooks("WATSOP19.xlsm").VBProject.VBComponents("uf1_main")
'update userform
'active
VBC.Designer.Controls("lb_cntaba_dt").Caption = cnt_dt
If cnt_dt = 0 Then
VBC.Designer.Controls("lb_cntaba_dt").Enabled = False
VBC.Designer.Controls("lb_aba_dt").Enabled = False
End If
VBC.Designer.Controls("lb_cntaba_dr").Caption = cnt_dr
If cnt_dr = 0 Then
VBC.Designer.Controls("lb_cntaba_dr").Enabled = False
VBC.Designer.Controls("lb_aba_dr").Enabled = False
End If
VBC.Designer.Controls("lb_cntaba_ft").Caption = cnt_ft
If cnt_ft = 0 Then
VBC.Designer.Controls("lb_cntaba_ft").Enabled = False
VBC.Designer.Controls("lb_aba_ft").Enabled = False
End If
VBC.Designer.Controls("lb_cntaba_fr").Caption = cnt_fr
If cnt_fr = 0 Then
VBC.Designer.Controls("lb_cntaba_fr").Enabled = False
VBC.Designer.Controls("lb_aba_fr").Enabled = False
End If
VBC.Designer.Controls("lb_cntaba_ct").Caption = cnt_ct
If cnt_ct = 0 Then
VBC.Designer.Controls("lb_cntaba_ct").Enabled = False
VBC.Designer.Controls("lb_aba_ct").Enabled = False
End If
VBC.Designer.Controls("lb_cntaba_cr").Caption = cnt_cr
If cnt_cr = 0 Then
VBC.Designer.Controls("lb_cntaba_cr").Enabled = False
VBC.Designer.Controls("lb_aba_cr").Enabled = Falsee
End If
VBC.Designer.Controls("lb_cntaba_ab").Caption = cnt_active
If cnt_active = 0 Then
VBC.Designer.Controls("lb_cntaba_ab").Enabled = False
VBC.Designer.Controls("lb_aba_ab").Enabled = False
End If
VBC.Designer.Controls("lb_cntmissa").Caption = Application.WorksheetFunction.Count(ws_temp1.Columns(1))
If VBC.Designer.Controls("lb_cntmissa").Caption > "0" Then
VBC.Designer.Controls("lb_cntmissa").BackColor = RGB(170, 6, 36)
VBC.Designer.Controls("lb_cntmissa").ForeColor = RGB(255, 255, 255)
VBC.Designer.Controls("lb_cntaba_dt").Enabled = False
VBC.Designer.Controls("lb_cntaba_dr").Enabled = False
VBC.Designer.Controls("lb_cntaba_ft").Enabled = False
VBC.Designer.Controls("lb_cntaba_fr").Enabled = False
VBC.Designer.Controls("lb_cntaba_ct").Enabled = False
VBC.Designer.Controls("lb_cntaba_cr").Enabled = False
VBC.Designer.Controls("lb_cntaba_ab").Enabled = False
VBC.Designer.Controls("lb_aba_dt").Enabled = False
VBC.Designer.Controls("lb_aba_dr").Enabled = False
VBC.Designer.Controls("lb_aba_ft").Enabled = False
VBC.Designer.Controls("lb_aba_fr").Enabled = False
VBC.Designer.Controls("lb_aba_ct").Enabled = False
VBC.Designer.Controls("lb_aba_cr").Enabled = False
VBC.Designer.Controls("lb_aba_ab").Enabled = False
Else
VBC.Designer.Controls("lb_cntmissa").Enabled = False
VBC.Designer.Controls("lb_missa").Enabled = False
End If
'passive
VBC.Designer.Controls("lb_cntpba_pc").Caption = cnt_pc
If cnt_pc = 0 Then
VBC.Designer.Controls("lb_cntpba_pc").Enabled = False
VBC.Designer.Controls("lb_pba_pc").Enabled = False
End If
VBC.Designer.Controls("lb_cntpba_bs").Caption = cnt_bs
If cnt_bs = 0 Then
VBC.Designer.Controls("lb_cntpba_bs").Enabled = False
VBC.Designer.Controls("lb_pba_bs").Enabled = False
End If
VBC.Designer.Controls("lb_cntpba_lg").Caption = cnt_lg
If cnt_lg = 0 Then
VBC.Designer.Controls("lb_cntpba_lg").Enabled = False
VBC.Designer.Controls("lb_pba_lg").Enabled = False
End If
VBC.Designer.Controls("lb_cntpba_vg").Caption = cnt_vg
If cnt_vg = 0 Then
VBC.Designer.Controls("lb_cntpba_vg").Enabled = False
VBC.Designer.Controls("lb_pba_vg").Enabled = False
End If
VBC.Designer.Controls("lb_cntpba_gm").Caption = cnt_gm
If cnt_gm = 0 Then
VBC.Designer.Controls("lb_cntpba_gm").Enabled = False
VBC.Designer.Controls("lb_pba_gm").Enabled = False
End If
VBC.Designer.Controls("lb_cntpba_pb").Caption = cnt_passive
If cnt_passive = 0 Then
VBC.Designer.Controls("lb_cntpba_pb").Enabled = False
VBC.Designer.Controls("lb_pba_pb").Enabled = False
End If
VBC.Designer.Controls("lb_cntmissp").Caption = Application.WorksheetFunction.Count(ws_temp1.Columns(2))
If VBC.Designer.Controls("lb_cntmissp").Caption > "0" Then
VBC.Designer.Controls("lb_cntmissp").BackColor = RGB(170, 6, 36)
VBC.Designer.Controls("lb_cntmissp").ForeColor = RGB(255, 255, 255)
VBC.Designer.Controls("lb_cntpba_pc").Enabled = False
VBC.Designer.Controls("lb_cntpba_lg").Enabled = False
VBC.Designer.Controls("lb_cntpba_bs").Enabled = False
VBC.Designer.Controls("lb_cntpba_gm").Enabled = False
VBC.Designer.Controls("lb_cntpba_vg").Enabled = False
VBC.Designer.Controls("lb_cntpba_pb").Enabled = False
VBC.Designer.Controls("lb_pba_pc").Enabled = False
VBC.Designer.Controls("lb_pba_lg").Enabled = False
VBC.Designer.Controls("lb_pba_bs").Enabled = False
VBC.Designer.Controls("lb_pba_gm").Enabled = False
VBC.Designer.Controls("lb_pba_vg").Enabled = False
VBC.Designer.Controls("lb_pba_pb").Enabled = False
Else
VBC.Designer.Controls("lb_cntmissp").Enabled = False
VBC.Designer.Controls("lb_missp").Enabled = False
End If
With ws_vh
cnt_mr = Application.WorksheetFunction.Count(.Range("L:M"))
If cnt_mr = 0 Then 'no more missing records, resume WATSOP19.uf1_main1
Application.DisplayAlerts = False
'wb_rd.Save
wb_rd.Close
Application.DisplayAlerts = True
Else 'return to group_1 to process rremaining missing rentals
mri = 1
Unload group_1
group_1.Show
End If
End With
End If
End Sub