The long break - Hunting

Lame joke is lame.

There was no new posts for some time (thank you captain obvious!), but I'm slowly making progress, yay!

I've almost finished hunting userform and hope to finish VBA code soon.

Well, nothing to see here. It's just a boring window. More interesting things happen in the code!

Here's the Initialize Procedure (with public variables added):

Public maxTime As Integer
Public sTime As Integer
Public hTime As Integer
Public player As String
Private Sub UserForm_Initialize()

Application.ScreenUpdating = False

Dim ws As Worksheet Dim ws_char1, ws_char2, ws_char3 As Worksheet Dim Status1, Status2, Status3 As String Dim sleep1Time, sleep2Time, sleep3Time As Integer Dim hunt1Time, hunt2Time, hunt3Time As Integer Set ws = Sheets("Corr")
Set ws_char1 = Sheets("char1")
Set ws_char2 = Sheets("char2")
Set ws_char3 = Sheets("char3")

timebox.Locked = True
timebox.Value = 0

player = Range("B2")

ws_char1.Select
Status1 = Range("D7")
sleep1Time = Range("G4")
hunt1Time = Range("G5")
If sleep1Time = "" Then sleep1Time = 0
If hunt1Time = "" Then hunt1Time = 0

ws_char2.Select Status2 = Range("D7") sleep2Time = Range("G4") hunt2Time = Range("G5") If sleep2Time = "" Then sleep2Time = 0 If hunt2Time = "" Then hunt2Time = 0
ws_char3.Select
Status3 = Range("D7")
sleep3Time = Range("G4")
hunt3Time = Range("G5")
If sleep3Time = "" Then sleep3Time = 0
If hunt3Time = "" Then hunt3Time = 0

maxTime = WorksheetFunction.max(sleep1Time + hunt1Time, sleep2Time + hunt2Time, sleep3Time + hunt3Time)
If maxTime = 0 Then maxTime = 24

Select Case player
Case "P1"
ws_char1.Select

Case "P2"
ws_char2.Select

Case "P3"
ws_char3.Select
End Select

Select Case Status
Case "Sleep"
MsgBox "The character is sleeping.", vbOKOnly

Case Else
Range("D7") = "Hunting"
End Select

ws.Select

Application.ScreenUpdating = True

End Sub

Hunt & arrows buttons and checkbox:

Private Sub hButton_Click()

Dim ws As Worksheet
Dim ws_char As Worksheet

Set ws = Sheets("Corr")

Select Case player
Case "P1"
Set ws_char = Sheets("char1")
If ws.Range("E2") = 1 Then ws.Range("E2") = 0

Case "P2"
Set ws_char = Sheets("char2")
If ws.Range("E9") = 1 Then ws.Range("E9") = 0

Case "P3"
Set ws_char = Sheets("char3")
If ws.Range("E17") = 1 Then ws.Range("E17") = 0
End Select
ws_char.Select

Range("D7") = "Hunt"
Range("G4") = sTime
Range("G5") = hTime

End Sub

Private Sub timebutton_Change()

timebutton.max = maxTime
timebutton.Min = 0
timebox.Value = timebutton.Value
If timebutton.Value = maxTime Then CheckBox1.Enabled = False Else CheckBox1.Enabled = True

End Sub

Private Sub SleepChBox_Click()

Select Case SleepChBox.Value
Case True
hTime = timebox.Value
sTime = maxTime - hTime

Case False
hTime = timebox.Value
sTime = 0
End Select

End Sub

Code responsible for counting in-game time had to be changed too. I haven't posted it before so I will show only updated version here:

Sub Cycle()

Dim time As Long
Dim hrs As Integer
Dim mins As Integer
Dim ws As Worksheet

Set ws = Sheets("Corr")

ws.Select
time = Range("BD2")

Select Case time
Case 1440
Select Case min_time
Case 0
time = 5
Case Else
time = 5 + min_time * 60
End Select

Case Else
Select Case min_time
Case 0
time = time + 5
Case Else
time = time + min_time * 60
End Select

End Select

hrs = WorksheetFunction.RoundDown(time / 60, 0)
If hrs = 24 Then hrs = 0
mins = time - hrs * 60
If hrs = 0 And mins = 1440 Then mins = 0

Range("BD2") = time
Range("BE2") = hrs
Range("BF2") = mins

End Sub