Combining vba

[bptaw]

I have some vba code associated with a login form, password and expiry date:

Private Sub cmdLogin_Click()

Dim user As String
Dim password As String
user = Me.txtUserID.Value
password = Me.txtPassword.Value

If [ISREF('ExpiryDate'!A1)] Then
If Date > Sheets("ExpiryDate").[A1] Then
MsgBox "This Trial version has now expired and the Workbook will close."
ActiveWorkbook.Close SaveChanges:=False
Else: MsgBox "This is a trial version and will expire on " & Sheets("ExpiryDate").[A1]
End If
Else
Worksheets.Add.Name = "ExpiryDate"
Sheets("ExpiryDate").[A1] = Date + 10
Sheets("ExpiryDate").Visible = xlVeryHidden
MsgBox "This is a trial version and will expire on " & Sheets("ExpiryDate").[A1]
End If

Application.ScreenUpdating = False

If (user = "admin" And password = "admin") Or (password = "tsmith") Then

Unload Me
' Unhide all worksheets in the workbook
Worksheets("TS").Visible = xlSheetVisible
Worksheets("Cost Your Hemp").Visible = xlSheetVisible
Worksheets("Maize").Visible = xlSheetVisible
Worksheets("Summary Page").Visible = xlSheetVisible
Worksheets("Water Calculations").Visible = xlSheetVisible


' Hide, Unhide a specific shape by name
Dim ws As Worksheet
Set ws = ActiveSheet ' Change to the desired worksheet
ws.Shapes("Login2").Visible = False
On Error GoTo 0 ' Reset error handling

Sheets("Cost Your Hemp").Select
Cells(2, 3).Select

Application.ScreenUpdating = True
Else

MsgBox "Invalid login credentials. Please try again."

End If

End Sub

I also have vba code in the ThisWorkbook to delete sheets when the date has expired. I think these could be combined, but I'm not sure how to do it.

Private Sub Workbook_Delete_Sheets()
Dim oneSheet As Worksheet
Dim workingNames As Variant, oneName As String
Dim lastDay As Date

lastDay = Sheets("ExpiryDate").[A1]

Select Case Date
Case Is < lastDay
Rem OK
GoSub HideHidden
Case Is = lastDay
Rem warning
MsgBox "This is the last day that you can use this worksheet"
GoSub HideHidden
Case Else
Rem delete stuff
GoSub KillSheets
End Select
Exit Sub
KillSheets:
ThisWorkbook.Sheets("Getting Started").Visible = xlSheetVisible
Application.DisplayAlerts = False
For Each oneSheet In ThisWorkbook.Sheets
If oneSheet.Name <> "Getting Started" Then
oneSheet.Visible = xlSheetHidden
oneSheet.Delete
End If
Next oneSheet
Application.DisplayAlerts = True
ThisWorkbook.Save
Return
HideHidden:
For Each oneSheet In ThisWorkbook.Sheets
If oneSheet.Name <> "Getting Started" Then
oneSheet.Visible = xlSheetVisible
End If
Next oneSheet
ThisWorkbook.Sheets("Getting Started").Visible = xlSheetVeryHidden
Return
End Sub


Any help?

 

[Joe4]

I think these could be combined, but I'm not sure how to do it.

Why do you think they should be (or need to be) combined into one?
I don't think that is necessary. People often separate their code into multiple procedures to make it easier to maintain and allow for easy re-use for specific tasks.

If you want to, it is easy to call one procedure from the other. It is quite common.
See: Calling Sub and Function procedures (VBA)