Run-Time Error 381

G

gilly01625

New Member
Joined
Nov 8, 2024
Messages
30
Office Version
  1. Prefer Not To Say
Platform
  1. Windows
Hey,

I have suddenly got a 'Run Time Error 381. Could not set the list property. Invalid property array index'.

Unsure why as userform was working fine - below is my code.

Can anyone figure out why? Going mad re-reading all my code, wonder if I've missed something or made a typo somewhere.

Thanks

VBA Code: 
Option Explicit

'===================================================================================================
'===================================================================================================
'Userform Initialize
'===================================================================================================
Private Sub UserForm_Initialize()
    
    RemoveCloseButton Me
    Call Refresh_Data
    
    Me.txtDateStart.value = Format(txtDateStart, "DD/MM/YYYY")
    Me.txtDateEnd.value = Format(txtDateStart, "DD/MM/YYYY")
    
    Me.chkUK.value = False
    Me.chkAUS.value = False
    Me.txtWID.value = ""
    Me.txtWREF.value = ""
    Me.cmbClient.value = ""
    Me.txtSubClient.value = ""
    Me.cmbType.value = ""
    Me.cmbLocation.value = ""
    Me.txtDateStart.value = ""
    Me.txtDateEnd.value = ""
    Me.txtS1Start.value = ""
    Me.txtS1End.value = ""
    Me.txtS2Start.value = ""
    Me.txtS2End.value = ""
    Me.txtS3Start.value = ""
    Me.txtS3End.value = ""
    Me.txtQuotedHours.value = ""
    Me.txtActualHours.value = ""
    Me.cmbTransportType.value = ""
    Me.txtTransportTotal.value = ""
    Me.txtMileage.value = ""
    Me.txtPetrol.value = ""
    Me.txtParking.value = ""
    Me.txtHourly.value = ""
    Me.txtDay.value = ""
    Me.txtSalary.value = ""
    Me.txtTotal.value = ""
    Me.cmbIID.value = ""
    Me.cmbPSID.value = ""
    Me.txtNotes.value = ""
    
    Me.cmbClient.RowSource = ""
    Me.cmbClient.List = Worksheets("Client").Range("E7", Worksheets("Client").Range("E" & Rows.Count).End(xlUp)).value
    
    Me.cmbType.RowSource = ""
    Me.cmbType.List = Worksheets("JobType").Range("D7", Worksheets("JobType").Range("D" & Rows.Count).End(xlUp)).value
    
    Me.cmbLocation.RowSource = ""
    Me.cmbLocation.List = Worksheets("Location").Range("D7", Worksheets("Location").Range("D" & Rows.Count).End(xlUp)).value
    
    
End Sub

'===================================================================================================
'===================================================================================================
'Control of the Menu Options
'===================================================================================================
'===================================================================================================
'Dashboard
'===================================================================================================

Private Sub frameDashboard_Click()

    Unload Me
    frmDashboard.Show

End Sub

Private Sub lblDashboard_Click()

    Unload Me
    frmDashboard.Show
    
End Sub

Private Sub imgDashboard_Click()

    Unload Me
    frmDashboard.Show
    
End Sub

'===================================================================================================
'Finance
'===================================================================================================

Private Sub frameFinance_Click()

    Unload Me
    frmFinance.Show

End Sub

Private Sub lblFinance_Click()

    Unload Me
    frmFinance.Show
    
End Sub

Private Sub imgFinance_Click()

    Unload Me
    frmFinance.Show
    
End Sub

'===================================================================================================
'Invoice
'===================================================================================================

Private Sub frameInvoice_Click()

    Unload Me
    frmInvoice.Show

End Sub

Private Sub lblInvoice_Click()

    Unload Me
    frmInvoice.Show
    
End Sub

Private Sub imgInvoice_Click()

    Unload Me
    frmInvoice.Show
    
End Sub

'===================================================================================================
'Back End
'===================================================================================================

Private Sub frameBackEnd_Click()

    Application.Visible = True
    Me.Hide
    
End Sub

Private Sub lblBackEnd_Click()

    Application.Visible = True
    Me.Hide
    
End Sub

Private Sub imgBackEnd_Click()

    Application.Visible = True
    Me.Hide
    
End Sub

'===================================================================================================
'Log Out
'===================================================================================================

Private Sub frameLogOut_Click()

    ThisWorkbook.Application.Quit

End Sub
    
Private Sub lblLogOut_Click()

    ThisWorkbook.Application.Quit
    
End Sub

Private Sub imgLogOut_Click()

    ThisWorkbook.Application.Quit
    
End Sub

'===================================================================================================
'===================================================================================================
'Highlight a Menu Option when Mouse Move
'===================================================================================================
'Userform
'===================================================================================================

'---------------------------------------------------------------------------------------------------
'Format the Retrieval of Information to the Userform
'---------------------------------------------------------------------------------------------------

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameDashboard.BackColor = &H492B27
    frameWork.BackColor = &H492B27
    frameFinance.BackColor = &H492B27
    frameInvoice.BackColor = &H492B27
    frameBackEnd.BackColor = &H492B27
    frameLogOut.BackColor = &H492B27
    
    Me.txtDateEnd = Format(txtDateEnd, "DD/MM/YYYY")
    Me.txtDateStart = Format(txtDateEnd, "DD/MM/YYYY")
    
    Me.txtS1Start = Format(txtS1Start, "HH:SS")
    Me.txtS1End = Format(txtS1End, "HH:SS")
    Me.txtS2Start = Format(txtS1Start, "HH:SS")
    Me.txtS2End = Format(txtS1End, "HH:SS")
    Me.txtS3Start = Format(txtS1Start, "HH:SS")
    Me.txtS3End = Format(txtS1End, "HH:SS")
    
End Sub

'===================================================================================================
'Side Bar
'===================================================================================================

Private Sub frameSideBar_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameDashboard.BackColor = &H492B27
    frameWork.BackColor = &H492B27
    frameFinance.BackColor = &H492B27
    frameInvoice.BackColor = &H492B27
    frameBackEnd.BackColor = &H492B27
    frameLogOut.BackColor = &H492B27

End Sub

'===================================================================================================
'Menu Options
'===================================================================================================
    
Private Sub frameDashboard_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameDashboard.BackColor = &H3A1F1A
    
End Sub

'---------------------------------------------------------------------------------------------------
'Populate ComboBoxes
'---------------------------------------------------------------------------------------------------

Private Sub frameWork_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameWork.BackColor = &H3A1F1A
    
End Sub
    
Private Sub frameFinance_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameFinance.BackColor = &H3A1F1A
    
End Sub
    
Private Sub frameInvoice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameInvoice.BackColor = &H3A1F1A
    
End Sub
    
Private Sub frameBackEnd_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameBackEnd.BackColor = &H3A1F1A
    
End Sub
    
Private Sub frameLogout_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    frameLogOut.BackColor = &H3A1F1A
    
End Sub

'===================================================================================================
'===================================================================================================
'Format the Retrieval of Information to the Userform
'===================================================================================================

Private Sub lstWorkDatabase_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Me.txtDateEnd = Format(txtDateEnd, "DD/MM/YYYY")
    Me.txtDateStart = Format(txtDateStart, "DD/MM/YYYY")
    
    Me.txtS1Start = Format(txtS1Start, "HH:SS")
    Me.txtS1End = Format(txtS1End, "HH:SS")
    Me.txtS2Start = Format(txtS2Start, "HH:SS")
    Me.txtS2End = Format(txtS2End, "HH:SS")
    Me.txtS3Start = Format(txtS3Start, "HH:SS")
    Me.txtS3End = Format(txtS3End, "HH:SS")

End Sub

'===================================================================================================
'===================================================================================================
'New Record to Table
'===================================================================================================
'Add
'===================================================================================================

Private Sub btnAdd_Click()
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim last_Row As Long
    last_Row = Application.WorksheetFunction.CountA(sh.Range("C:C"))
    
    sh.Range("C" & last_Row + 1).value = "=Row()-6"
    sh.Range("D" & last_Row + 1).value = Me.txtWREF.value
    sh.Range("E" & last_Row + 1).value = Me.cmbClient.value
    sh.Range("F" & last_Row + 1).value = Me.txtSubClient.value
    sh.Range("G" & last_Row + 1).value = Me.cmbType.value
    sh.Range("H" & last_Row + 1).value = Me.cmbLocation.value
    sh.Range("I" & last_Row + 1).value = Me.txtDateStart.value
    sh.Range("J" & last_Row + 1).value = Me.txtDateEnd.value
    sh.Range("K" & last_Row + 1).value = Me.txtS1Start.value
    sh.Range("L" & last_Row + 1).value = Me.txtS1End.value
    sh.Range("M" & last_Row + 1).value = Me.txtS2Start.value
    sh.Range("N" & last_Row + 1).value = Me.txtS2End.value
    sh.Range("O" & last_Row + 1).value = Me.txtS3Start.value
    sh.Range("P" & last_Row + 1).value = Me.txtS3End.value
    sh.Range("Q" & last_Row + 1).value = Me.txtQuotedHours.value
    sh.Range("R" & last_Row + 1).value = Me.txtActualHours.value
    sh.Range("S" & last_Row + 1).value = Me.cmbTransportType.value
    sh.Range("T" & last_Row + 1).value = Me.txtTransportTotal.value
    sh.Range("U" & last_Row + 1).value = Me.txtMileage.value
    sh.Range("V" & last_Row + 1).value = Me.txtPetrol.value
    sh.Range("W" & last_Row + 1).value = Me.txtParking.value
    sh.Range("X" & last_Row + 1).value = Me.txtHourly.value
    sh.Range("Y" & last_Row + 1).value = Me.txtDay.value
    sh.Range("Z" & last_Row + 1).value = Me.txtSalary.value
    sh.Range("AA" & last_Row + 1).value = Me.txtTotal.value
    sh.Range("AB" & last_Row + 1).value = Me.cmbIID.value
    sh.Range("AC" & last_Row + 1).value = Me.cmbPSID.value
    sh.Range("AD" & last_Row + 1).value = Me.txtNotes.value
    sh.Range("AE" & last_Row + 1).value = Now
    sh.Range("AF" & last_Row + 1).value = Me.txtCountryHIDDEN.value
    
    Me.chkUK.value = False
    Me.chkAUS.value = False
    Me.txtWREF.value = ""
    Me.cmbClient.value = ""
    Me.txtSubClient.value = ""
    Me.cmbType.value = ""
    Me.cmbLocation.value = ""
    Me.txtDateStart.value = ""
    Me.txtDateEnd.value = ""
    Me.txtS1Start.value = ""
    Me.txtS1End.value = ""
    Me.txtS2Start.value = ""
    Me.txtS2End.value = ""
    Me.txtS3Start.value = ""
    Me.txtS3End.value = ""
    Me.txtQuotedHours.value = ""
    Me.txtActualHours.value = ""
    Me.cmbTransportType.value = ""
    Me.txtTransportTotal.value = ""
    Me.txtMileage.value = ""
    Me.txtPetrol.value = ""
    Me.txtParking.value = ""
    Me.txtHourly.value = ""
    Me.txtDay.value = ""
    Me.txtSalary.value = ""
    Me.txtTotal.value = ""
    Me.cmbIID.value = ""
    Me.cmbPSID.value = ""
    Me.txtNotes.value = ""
    
    Call Refresh_Data
    
End Sub

'===================================================================================================
'Clear
'===================================================================================================

Private Sub btnClear_Click()

    Me.chkUK.value = False
    Me.chkAUS.value = False
    Me.txtWID.value = ""
    Me.txtWREF.value = ""
    Me.cmbClient.value = ""
    Me.txtSubClient.value = ""
    Me.cmbType.value = ""
    Me.cmbLocation.value = ""
    Me.txtDateStart.value = ""
    Me.txtDateEnd.value = ""
    Me.txtS1Start.value = ""
    Me.txtS1End.value = ""
    Me.txtS2Start.value = ""
    Me.txtS2End.value = ""
    Me.txtS3Start.value = ""
    Me.txtS3End.value = ""
    Me.txtQuotedHours.value = ""
    Me.txtActualHours.value = ""
    Me.cmbTransportType.value = ""
    Me.txtTransportTotal.value = ""
    Me.txtMileage.value = ""
    Me.txtPetrol.value = ""
    Me.txtParking.value = ""
    Me.txtHourly.value = ""
    Me.txtDay.value = ""
    Me.txtSalary.value = ""
    Me.txtTotal.value = ""
    Me.cmbIID.value = ""
    Me.cmbPSID.value = ""
    Me.txtNotes.value = ""
    
End Sub

'===================================================================================================
'Delete
'===================================================================================================

Private Sub btnDelete_Click()

    If Me.txtWID.value = "" Then
        MsgBox "Select a record to delete"
    Exit Sub
    End If
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim Selected_Row As Long
    Selected_Row = Application.WorksheetFunction.Match(CLng(Me.txtWID.value), sh.Range("C:C"), 0)
    
    sh.Range("A" & Selected_Row).EntireRow.Delete
    
    Call Refresh_Data
    
    Me.chkUK.value = False
    Me.chkAUS.value = False
    Me.txtWID.value = ""
    Me.txtWREF.value = ""
    Me.cmbClient.value = ""
    Me.txtSubClient.value = ""
    Me.cmbType.value = ""
    Me.cmbLocation.value = ""
    Me.txtDateStart.value = ""
    Me.txtDateEnd.value = ""
    Me.txtS1Start.value = ""
    Me.txtS1End.value = ""
    Me.txtS2Start.value = ""
    Me.txtS2End.value = ""
    Me.txtS3Start.value = ""
    Me.txtS3End.value = ""
    Me.txtQuotedHours.value = ""
    Me.txtActualHours.value = ""
    Me.cmbTransportType.value = ""
    Me.txtTransportTotal.value = ""
    Me.txtMileage.value = ""
    Me.txtPetrol.value = ""
    Me.txtParking.value = ""
    Me.txtHourly.value = ""
    Me.txtDay.value = ""
    Me.txtSalary.value = ""
    Me.txtTotal.value = ""
    Me.cmbIID.value = ""
    Me.cmbPSID.value = ""
    Me.txtNotes.value = ""
    
End Sub

'===================================================================================================
'Save
'===================================================================================================

Private Sub btnSave_Click()

    ThisWorkbook.Save
    MsgBox "Data Saved"
    
End Sub

'===================================================================================================
'Update
'===================================================================================================

Private Sub btnUpdate_Click()

    Me.txtDateEnd = Format(Format(txtDateEnd, "Long Date"), "DD/MM/YYYY")
    Me.txtDateStart = Format(Format(txtDateStart, "Long Date"), "DD/MM/YYYY")

    If Me.txtWID.value = "" Then
    
        MsgBox "Select a record to update"
    
    End If
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim Selected_Row As Long
    Selected_Row = Application.WorksheetFunction.Match(CLng(Me.txtWID.value), sh.Range("C:C"), 0)
    
    sh.Range("D" & Selected_Row).value = Me.txtWREF.value
    sh.Range("E" & Selected_Row).value = Me.cmbClient.value
    sh.Range("F" & Selected_Row).value = Me.txtSubClient.value
    sh.Range("G" & Selected_Row).value = Me.cmbType.value
    sh.Range("H" & Selected_Row).value = Me.cmbLocation.value
    sh.Range("I" & Selected_Row).value = Me.txtDateStart.value
    sh.Range("J" & Selected_Row).value = Me.txtDateEnd.value
    sh.Range("K" & Selected_Row).value = Me.txtS1Start.value
    sh.Range("L" & Selected_Row).value = Me.txtS1End.value
    sh.Range("M" & Selected_Row).value = Me.txtS2Start.value
    sh.Range("N" & Selected_Row).value = Me.txtS2End.value
    sh.Range("O" & Selected_Row).value = Me.txtS3Start.value
    sh.Range("P" & Selected_Row).value = Me.txtS3End.value
    sh.Range("Q" & Selected_Row).value = Me.txtQuotedHours.value
    sh.Range("R" & Selected_Row).value = Me.txtActualHours.value
    sh.Range("S" & Selected_Row).value = Me.cmbTransportType.value
    sh.Range("T" & Selected_Row).value = Me.txtTransportTotal.value
    sh.Range("U" & Selected_Row).value = Me.txtMileage.value
    sh.Range("V" & Selected_Row).value = Me.txtPetrol.value
    sh.Range("W" & Selected_Row).value = Me.txtParking.value
    sh.Range("X" & Selected_Row).value = Me.txtHourly.value
    sh.Range("Y" & Selected_Row).value = Me.txtDay.value
    sh.Range("Z" & Selected_Row).value = Me.txtSalary.value
    sh.Range("AA" & Selected_Row).value = Me.txtTotal.value
    sh.Range("AB" & Selected_Row).value = Me.cmbIID.value
    sh.Range("AC" & Selected_Row).value = Me.cmbPSID.value
    sh.Range("AD" & Selected_Row).value = Me.txtNotes.value
    sh.Range("AE" & Selected_Row).value = Now
    sh.Range("AF" & Selected_Row).value = Me.txtCountryHIDDEN.value
    
    Me.chkUK.value = False
    Me.chkAUS.value = False
    Me.txtWID.value = ""
    Me.txtWREF.value = ""
    Me.cmbClient.value = ""
    Me.txtSubClient.value = ""
    Me.cmbType.value = ""
    Me.cmbLocation.value = ""
    Me.txtDateStart.value = ""
    Me.txtDateEnd.value = ""
    Me.txtS1Start.value = ""
    Me.txtS1End.value = ""
    Me.txtS2Start.value = ""
    Me.txtS2End.value = ""
    Me.txtS3Start.value = ""
    Me.txtS3End.value = ""
    Me.txtQuotedHours.value = ""
    Me.txtActualHours.value = ""
    Me.cmbTransportType.value = ""
    Me.txtTransportTotal.value = ""
    Me.txtMileage.value = ""
    Me.txtPetrol.value = ""
    Me.txtParking.value = ""
    Me.txtHourly.value = ""
    Me.txtDay.value = ""
    Me.txtSalary.value = ""
    Me.txtTotal.value = ""
    Me.cmbIID.value = ""
    Me.cmbPSID.value = ""
    Me.txtNotes.value = ""
    
    Call Refresh_Data
    
End Sub

'===================================================================================================
'Pull Table Contents to Userform Input Options
'===================================================================================================

Private Sub lstWorkDatabase_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    Me.txtWID.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 0)
    Me.txtWREF.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 1)
    Me.cmbClient.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 2)
    Me.txtSubClient.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 3)
    Me.cmbType.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 4)
    Me.cmbLocation.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 5)
    Me.txtDateStart.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 6)
    Me.txtDateEnd.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 7)
    Me.txtS1Start.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 8)
    Me.txtS1End.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 9)
    Me.txtS2Start.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 10)
    Me.txtS2End.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 11)
    Me.txtS3Start.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 12)
    Me.txtS3End.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 13)
    Me.txtQuotedHours.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 14)
    Me.txtActualHours.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 15)
    Me.cmbTransportType.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 16)
    Me.txtTransportTotal.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 17)
    Me.txtMileage.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 18)
    Me.txtPetrol.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 19)
    Me.txtParking.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 20)
    Me.txtHourly.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 21)
    Me.txtDay.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 22)
    Me.txtSalary.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 23)
    Me.txtTotal.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 24)
    Me.cmbIID.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 25)
    Me.cmbPSID.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 26)
    Me.txtNotes.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 27)
    Me.txtCountryHIDDEN.value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 29)
    
    If Me.txtCountryHIDDEN.value = "UK" Then
    
        Me.chkUK.value = True
        Me.chkAUS.value = False
        
    End If
    
    If Me.txtCountryHIDDEN.value = "AUS" Then
    
        Me.chkAUS.value = True
        Me.chkUK.value = False
        
    End If
    
End Sub

'===================================================================================================
'Display Table Contents on Userform Database
'===================================================================================================

Sub Refresh_Data()

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim last_Row As Long
    last_Row = Application.WorksheetFunction.CountA(sh.Range("C:C"))
    
    With Me.lstWorkDatabase
        .ColumnHeads = True
        .ColumnCount = 28
        .ColumnWidths = "30,90,80,80,90,100,60,60,40,40,40,40,40,40,50,50,50,50,50,50,50,50,50,50,50,60,60,100,100,50"
        
        If last_Row = 1 Then
        .RowSource = "Work!C7:AF7"
        Else
        .RowSource = "Work!C7:AF7" & last_Row
        End If
        
    End With
    
End Sub

'===================================================================================================
'===================================================================================================
'Additional Buttons for Userforms
'===================================================================================================
'New Client
'===================================================================================================

Private Sub btnNewClient_Click()

    frmClient.Show
    
End Sub

'===================================================================================================
'New Job Type
'===================================================================================================

Private Sub btnNewType_Click()

    frmJobType.Show
    
End Sub

'===================================================================================================
'New Location
'===================================================================================================

Private Sub btnNewLocation_Click()

    frmLocation.Show
    
End Sub

'===================================================================================================
'===================================================================================================
'Change of Combo Boxes
'===================================================================================================

Private Sub txtCountryHIDDEN_Change()

    If Me.txtCountryHIDDEN = "UK" Then
    
        Me.cmbTransportType.Clear
        Me.cmbTransportType.AddItem "Bus"
        Me.cmbTransportType.AddItem "Plane"
        Me.cmbTransportType.AddItem "Taxi"
        Me.cmbTransportType.AddItem "Tram"
        
    End If
    
    If Me.txtCountryHIDDEN = "AUS" Then
    
        Me.cmbTransportType.Clear
        Me.cmbTransportType.AddItem "Bus"
        Me.cmbTransportType.AddItem "Lite Rail"
        Me.cmbTransportType.AddItem "Plane"
        Me.cmbTransportType.AddItem "Taxi"
        
    End If
        
End Sub

'===================================================================================================
'===================================================================================================
'Updating of Date Format from 1900 Date System to Long Date
'===================================================================================================

Private Sub txtDateEnd_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    Me.txtDateEnd = Format(txtDateEnd, "DD/MM/YYYY")

End Sub

Private Sub txtDateStart_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    Me.txtDateStart = Format(txtDateStart, "DD/MM/YYYY")

End Sub

'===================================================================================================
'===================================================================================================
'Generating Work Reference Number
'===================================================================================================

Private Sub chkUK_Click()

    If Me.chkUK.value = True Then
    
        Me.txtCountryHIDDEN.value = "UK"
        GenerateReferenceNumber "OLUK-WREF"
        Me.chkAUS.value = False
    
    End If

End Sub

Private Sub chkAUS_Click()

    If Me.chkAUS.value = True Then
    
        Me.txtCountryHIDDEN.value = "AUS"
        GenerateReferenceNumber "OLAUS-WREF"
        Me.chkUK.value = False
        
    End If

End Sub

Private Sub GenerateReferenceNumber(ByVal Prefix As String)
    Dim cell        As Range

    Dim ws          As Worksheet
    Set ws = ThisWorkbook.Worksheets("Work")

    Dim lastRow     As Long
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    Dim lastNumber  As Long
    lastNumber = 0

    For Each cell In ws.Range("D7:D" & lastRow)

        If InStr(cell.value, Prefix) > 0 Then

            lastNumber = Application.WorksheetFunction.Max(lastNumber, CInt(Mid(cell.value, Len(Prefix) + 2)))
        End If

    Next cell

    Dim newNumber   As Long
    newNumber = lastNumber + 1

    Dim newReference As String
    newReference = Prefix & "-" & Format(newNumber, "0000")

    Me.txtWREF.value = newReference
    
End Sub

'===================================================================================================
 
Sort by date Sort by votes
Am I the only one being presented with a login form and not finding the login details in a post here?
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Never mind. Just learned how to get in. Excel security is even worse than Access.
Or is it just because of the way this wb protection code was written? Probably not, I guess.
 
Upvote 0
OK, so it appears as though it is like I said way back. I added 2 more list items to the location sheet and the problem goes away. I don't understand that completely though because when the error is raised a list count value is not being referenced. All I can think of is that 1 item cannot be considered an array in this case.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Locked
  • Question Question
VBA Userform - Change from 1900 Date Format to Long Date
Replies
1
Views
69
Peter_SSs
Peter_SSs
G
  • Question Question
Format Pulled Data from Workbook into a Text Box
Replies
3
Views
65
Skyybot
Skyybot
G
  • Question Question
VBA Userform Date Format
Replies
7
Views
207
gilly01625
G
P
  • Question Question
ListBox Click to textbox & delete row
Replies
0
Views
609
pure vito
P
X
  • Solved
Displayed numeric date instead of the entered format date
Replies
6
Views
499
hicksi
hicksi

Forum statistics

Threads
1,224,272
Messages
6,177,632
Members
452,786
Latest member
k3calloway

Share this page

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