User Form ComboBox - Invalid Property Value

mikeymay · Jun 12, 2022

I have a number of comboxboxes in a UF, all have exactly the same functional properties other than sizes, rowsource, etc.

In one particular combobox if I click into it or it is selected by a .setfocus, if I then click away from it I get the Invalid Property Value error message BUT without the comboxbox AfterUpdate code executing.

The combox is to select an option for a label for an item selected from a listbox.

This item is then moved into another listbox (to show the items selected) and the combobox clears as part of the process to allow another item to be selected and a flag selected from the combobox.

When the first item is selected to drop into the listbox, .setfocus naviagtes to the combobox and you can navigate away from it without the error.

When a 2nd item is selected and the form navigates to the combobox, if I click away without selecting anything then the rror comes up.

In all the other combobox in the form (all other comboboxes are a one time selection), this behaviour does not occur.

I can't have the setting for MatchEntry to allow any entry as the options are sourced from a RowSource address.

TIA

6StringJazzer · Jun 12, 2022

mikeymay said:
if I then click away from it I get the Invalid Property Value error message

This is a code question and there is no hope of answering your question without your code. Please show your code and indicate which line of code is causing this error.

mikeymay · Jun 13, 2022

Opens the UF

VBA Code:

Sub Order1New()

Dim intOLRows As Integer

boolExit = False
boolAmendPO = False
boolVerifyPO = False
boolPopulateUF = False

Application.Calculation = xlManual

GetDL

cnConn.Close

Set cnConn = Nothing

'Open UF
Load frmOrder1New

With frmOrder1New
   .cbPT.RowSource = strH & Range("D_HoldingOPT").Address
   .cbCurr.RowSource = strH & Range("D_HoldingOCurrencies").Address
   .cbMill.RowSource = strH & Range("D_HoldingOMills").Address
   .cbDelText.RowSource = strH & Range("D_HoldingODText").Address
   .cbDelTerms.RowSource = strH & Range("D_HoldingODTerms").Address
   .cbGO.RowSource = strH & Range("D_HoldingGO").Address

   .Show
End With

Application.Calculation = xlAutomatic

Unload frmOrder1New

If boolExit = True Then
   Else
   EmailPO
End If

ClearHolding

If boolExit = True Then
   Exit Sub
   Else
   MsgBox ("The Order has been saved and emailed to the selected mill"), vbInformation, "SAVED"
End If

End Sub

GetDL Code

VBA Code:

Sub GetDL()

'Open DB
Connection

'Get Customers
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT " & Range("Holding_OCustomersQuery") & " FROM Customers ORDER BY Customer Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_OCustomerStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Payment Terms
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT Payment_Term FROM PaymentTerms ORDER BY Payment_Term Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_OPTStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Currencies
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT Currency FROM Currencies ORDER BY Currency Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_OCurrencyStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Mills
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT Mill FROM Mills"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_OMillStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Del Loctions
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT " & Range("Holding_ODAQuery") & " FROM DeliveryAddress ORDER BY Location Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_ODAStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Del Text
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT Delivery_Text FROM DeliveryText ORDER BY Delivery_Text Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_ODTextStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Del Terms
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT Delivery_Term FROM DeliveryTerms ORDER BY Delivery_Term Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_ODTermsStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get GO
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT Green_Option FROM GreenOptions ORDER BY Green_Option Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_OGOStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

'Get Products
Set rsQuery = CreateObject("ADODB.Recordset")

strQuery = "SELECT " & Range("Holding_OProductQuery") & " FROM Products ORDER BY Product Asc"

rsQuery.Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
Range("Holding_OProductStart").Offset(1, 0).CopyFromRecordset rsQuery

rsQuery.Close

Set rsQuery = Nothing

Calculate

End Sub

ClearHolding Code

VBA Code:

Sub ClearHolding()

Range("Holding_OCustomer") = ""
Range("Holding_OCustomersClear").ClearContents
Range("Holding_OPTClear").ClearContents
Range("Holding_OCurrencyClear").ClearContents
Range("Holding_OMillsClear").ClearContents
Range("Holding_ODA") = ""
Range("Holding_ODAClear").ClearContents
Range("Holding_ODTextClear").ClearContents
Range("Holding_ODTermsClear").ClearContents
Range("Holding_OGOClear").ClearContents
Range("Holding_OMill") = ""
Range("Holding_OProduct") = ""
Range("Holding_OProductsClear").ClearContents
Range("Holding_OUnit") = ""
Range("Holding_OOLClear").ClearContents

Range("MO_PT") = ""
Range("MO_PONo") = ""
Range("MO_ON") = ""
Range("MO_MillOrder") = ""
Range("MO_DText") = ""
Range("MO_PI") = ""

End Sub

UF Code

VBA Code:

Option Explicit

Dim rngHeader As Range

Dim strTonnage

Dim dblLV As Double

Dim intItem As Integer

Dim boolSave As Boolean
Dim boolApplyListBox As Boolean
Dim boolDelDate As Boolean
Dim boolSize2 As Boolean
Dim boolError As Boolean
Dim boolAmendLine As Boolean
Dim boolClearForm As Boolean
Dim boolClearOL As Boolean
Dim BoolDelLine As Boolean
Dim boolClear As Boolean
'------Other End

Private Sub txtCustomer_Change()

If boolApplyListBox = True Or boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

Range("Holding_OCustomer") = Trim(txtCustomer)

Range("Holding_CalcCustomer").Calculate

If Trim(txtCustomer) = "" Then
   Range("Holding_OCustomer") = ""
   
   lbCustomer.RowSource = ""
   lbCustomer.Enabled = False
   Else
   If Range("Holding_OCustomerMatch") = 0 Then
      lbCustomer = ""
      lbCustomer.Enabled = False
      Else
      lbCustomer.Enabled = True
      lbCustomer.RowSource = strH & Range("D_HoldingOCustomers").Address
   End If
End If
   
CheckSave

End Sub

Private Sub txtCustomer_AfterUpdate()

If txtCustomer <> "" And lbCustomer.ListCount = 0 Then
   Exit Sub
   Else
End If

If Range("Holding_OCustomerMatch") = 1 Then
   boolApplyListBox = True

   txtCustomer = lbCustomer.List(0)
     
   boolApplyListBox = False
   
   lbCustomer.RowSource = ""
   lbCustomer.Enabled = False
   
   txtOrderNo.SetFocus
   Else
End If

strCustomer = txtCustomer

CheckSave

End Sub

Private Sub lbCustomer_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

With lbCustomer
   For intItem = 0 To .ListCount - 1
      If .Selected(intItem) = True Then
         boolApplyListBox = True
      
         txtCustomer = .List(intItem)
         
         boolApplyListBox = False
         
         Exit For
         Else
      End If
   Next
End With

strCustomer = txtCustomer

lbCustomer.RowSource = ""
lbCustomer.Enabled = False

txtOrderNo.SetFocus

End Sub

Private Sub txtOrderNo_AfterUpdate()

strON = Trim(txtOrderNo)

CheckSave

End Sub

Private Sub txtCommRate_afterUpdate()

If IsNumeric(txtCommRate) = False Then
   txtCommRate = ""
   
   Exit Sub
   Else
End If

If CDbl(txtCommRate) >= 0 And CDbl(txtCommRate) <= 5 Then
   txtCommRate = Format(CCur(txtCommRate) / 100, "0.00%")

   sglComm = Replace(txtCommRate, "%", "")
   Else
   MsgBox ("Enter a positive numeric value => 0 and <=5"), vbExclamation, "VALUE ERROR"
   
   txtCommRate = ""
   txtCommRate.SetFocus

   sglComm = 0
End If

CheckSave

End Sub

Private Sub cbPT_Change()

If boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

If cbPT = "" Then
   cbPT.SetFocus
   Else
   cbCurr.SetFocus
End If

strPT = cbPT

CheckSave

End Sub

Private Sub cbCurr_Change()

If boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

If cbCurr = "" Then
   cbCurr.SetFocus
   Else
   cbMill.SetFocus
End If

strCurr = cbCurr

CheckSave

End Sub

Private Sub cbMill_Change()

If cbMill = "" Or boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

Range("Holding_OMill") = cbMill

strMill = cbMill

If strMill = "" Then
   cbMill.SetFocus
   Else
   txtDelAddress.SetFocus
End If

CheckSave

End Sub

Private Sub txtDelAddress_Change()

If boolApplyListBox = True Or boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

Range("Holding_ODA") = txtDelAddress

Range("Holding_CalcDA").Calculate

If txtDelAddress = "" Then
   lblDelAddress = ""

   lbDelAddress.RowSource = ""
   lbDelAddress.Enabled = False
   Else
   If Range("Holding_ODAMatch") = 0 Then
      lbDelAddress.RowSource = ""
      Else
      lbDelAddress.Enabled = True
      lbDelAddress.RowSource = strH & Range("D_HoldingODA").Address
   End If
End If

CheckSave

End Sub

Private Sub txtDelAddress_AfterUpdate()

If txtDelAddress <> "" And lbDelAddress.ListCount = 0 Then
   Exit Sub
   Else
End If

Range("Holding_CalcDA").Calculate

If Range("Holding_ODAMatch") = 1 Then
   boolApplyListBox = True

   txtDelAddress = lbDelAddress.List(0)
   
   lblDelAddress = txtDelAddress
   
   boolApplyListBox = False
   
   lbDelAddress.RowSource = ""
   lbDelAddress.Enabled = False
   
   strDA = txtDelAddress
   Else
   strDA = ""
End If

CheckSave

End Sub

Private Sub lbDelAddress_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

With lbDelAddress
   For intItem = 0 To .ListCount - 1
      If .Selected(intItem) = True Then
         boolApplyListBox = True
      
         txtDelAddress = .List(intItem)
         
         Range("Holding_ODA") = txtDelAddress
         
         boolApplyListBox = False
         
         Exit For
         Else
      End If
   Next
End With

strDA = txtDelAddress

Range("Holding_ODA") = strDA

Range("Holding_ODAFull").Calculate

lblDelAddress = Range("Holding_ODAFull")

lbDelAddress.RowSource = ""
lbDelAddress.Enabled = False

End Sub

Private Sub txtPackInfo_AfterUpdate()

strPI = Replace(Trim(txtPackInfo), "  ", " ")

CheckSave

End Sub

Private Sub cbDelText_Change()

If boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

If cbDelText = "" Then
   Else
   If LCase(cbDelText) = "order not free" Then
      boolDelDate = False
           
      txtDelDate = ""
            
      txtDelDate.Enabled = False
      
      Else
      boolDelDate = True
      
      txtDelDate.Enabled = True
   End If
End If

strDText = cbDelText

If strDText = "" Then
   cbDelText.SetFocus
   Else
   If boolDelDate = True Then
      txtDelDate.SetFocus
      Else
      cbDelTerms.SetFocus
   End If
End If

CheckSave

End Sub

Private Sub txtDelDate_AfterUpdate()

If txtDelDate = "" Then
   Else
   If IsDate(txtDelDate) Then
      txtDelDate = Format(txtDelDate, " d mmm yy")
      Else
      MsgBox ("Enter a valid date value only, e.g. '31/05/22'"), vbExclamation, "ERROR"
      
      txtDelDate = ""
      
      txtDelDate.SetFocus
   End If
End If
     
If txtDelDate = "" Then
   txtDelDate.SetFocus
   Else
   cbDelTerms.SetFocus
End If
   
dtDel = txtDelDate

CheckSave

End Sub

Private Sub cbDelTerms_Change()

If boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

If cbDelTerms = "" Then
   cbDelTerms = ""
   Else
   cbGO.SetFocus
End If

strDTerms = cbDelTerms

CheckSave

End Sub

Private Sub cbGO_Change()

If boolClearForm = True Or boolPopulateUF = True Then
   Exit Sub
   Else
End If

If cbGO = "" Then
   cbGO = ""
   Else
   txtProduct.SetFocus
End If

strGO = cbGO


CheckSave

End Sub

Private Sub txtProduct_Change()

If boolApplyListBox = True Or boolClearOL = True Or boolAmendLine = True Then
   Exit Sub
   Else
End If

Range("Holding_OProduct") = Trim(txtProduct)

Range("Holding_CalcProducts").Calculate

If txtProduct = "" Then
   btnAdd.Enabled = False
   btnClearLine.Enabled = False
   
   If Range("Holding_OMill") = "" Then
      lbProducts.RowSource = ""
      lbProducts.Enabled = False
      Else
      Range("Holding_OProduct") = ""
      
      lbProducts.Enabled = True
      lbProducts.RowSource = ""
   End If
      
   Range("Holding_OProduct") = ""
   
   boolApplyListBox = True
   
   cbUnit = ""
   cbUnit.Enabled = False
   
   txtUnitPrice = ""
   txtUnitPrice.Enabled = False
   
   txtQty = ""
   txtQty.Enabled = False
   
   txtSize1 = ""
   txtSize1.Enabled = False
   
   txtSize2 = ""
   txtSize2.Enabled = False
   
   txtGSM = ""
   txtGSM.Enabled = False
   
   txtMarks = ""
   txtMarks.Enabled = False
   
   boolApplyListBox = False
   Else
   btnClearLine.Enabled = True
   
   If Range("Holding_OProductsMatch") = 0 Then
      lbProducts.RowSource = ""
      
      If cbUnit <> "" Or txtUnitPrice <> "" Or txtQty <> "" Or txtSize1 <> "" Or txtSize2 <> "" Or txtGSM <> "" Then
         Else
         cbUnit = ""
         cbUnit.Enabled = False
         
         txtUnitPrice = ""
         txtUnitPrice.Enabled = False
         
         txtQty = ""
         txtQty.Enabled = False
         
         txtSize1 = ""
         txtSize1.Enabled = False
         
         txtSize2 = ""
         txtSize2.Enabled = False
         
         txtGSM = ""
         txtGSM.Enabled = False
         
         txtMarks = ""
         txtMarks.Enabled = False
      End If
      Else
      lbProducts.Enabled = True
      lbProducts.RowSource = strH & Range("D_HoldingOProducts").Address
      
      If Range("Holding_OProductsMatch") = 1 Then
         cbUnit.Enabled = True
         txtUnitPrice.Enabled = True
         txtQty.Enabled = True
         txtSize1.Enabled = True
         txtGSM.Enabled = True
         txtMarks.Enabled = True
         Else
      End If
      
   End If
End If
   
CheckSave

End Sub

Private Sub txtProduct_AfterUpdate()
   
CheckOrderLine
CheckSave
   
End Sub

Private Sub lbProducts_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

With lbProducts
   For intItem = 0 To .ListCount - 1
      If .Selected(intItem) = True Then
         boolApplyListBox = True
      
         txtProduct = .List(intItem)
         
         Range("Holding_OProduct") = txtProduct
         
         strProduct = Range("Holding_OProduct")
         
         Range("Holding_CalcProducts").Calculate
         
         boolApplyListBox = False
         
         cbUnit.Enabled = True
         txtUnitPrice.Enabled = True
         txtQty.Enabled = True
         txtSize1.Enabled = True
         txtGSM.Enabled = True
         txtMarks.Enabled = True
         
         Exit For
         Else
      End If
   Next
End With

lbProducts.RowSource = ""
lbProducts.Enabled = False

CheckOrderLine

End Sub

Private Sub cbUnit_Change()

If cbUnit = "" Or boolApplyListBox = True Or boolClearOL = True Or boolAmendLine = True Then
   Exit Sub
   Else
End If

If cbUnit = "" Then
   boolSize2 = False
   
   cbUnit.SetFocus
   Else
'   If WorksheetFunction.CountIf(Range("DL_Units"), cbUnit) = 0 Then
'      Else
      If Application.WorksheetFunction.XLookup(cbUnit, Range("D_HoldingUnits"), Range("D_HoldingUnits").Offset(0, 2)) = "Y" Then
         
         txtSize2.Enabled = True
         
         boolSize2 = True
         Else
         txtSize2 = ""
         
         txtSize2.Enabled = False
         
         boolSize2 = False
      End If
      
      txtUnitPrice.SetFocus
'   End If
End If

Range("Holding_OUnit") = cbUnit

strUT = cbUnit

CheckOrderLine

End Sub

Private Sub txtUnitPrice_AfterUpdate()

On Error Resume Next

dblUP = CCur(txtUnitPrice)

If Err.Number = 0 Then
   boolError = False
   Else
   boolError = True
End If
   
On Error GoTo 0

If boolError = False Then
   If dblUP > 0 Then
      txtUnitPrice = Format(dblUP, "#,##0.00")
      Else
      MsgBox ("Enter a positive numeric value"), vbExclamation, "VALUE ERROR"
      
      txtUnitPrice = ""
      txtUnitPrice.SetFocus
   End If
   Else
   txtUnitPrice = ""
   txtUnitPrice.SetFocus
End If

CheckOrderLine

End Sub

Private Sub txtQty_AfterUpdate()

On Error Resume Next

dblQty = CCur(txtQty)

If Err.Number = 0 Then
   boolError = False
   Else
   boolError = True
End If
   
On Error GoTo 0

If boolError = False Then
   If dblQty > 0 Then
      If cbUnit = "Tonnes" Then
         txtQty = Format(dblQty, "#,##0.000")
         Else
         txtQty = Format(dblQty, "#,##0")
      End If
      Else
      MsgBox ("Enter a positive numeric value"), vbExclamation, "VALUE ERROR"
      
      txtQty = ""
      txtQty.SetFocus
   End If
   Else
   txtQty = ""
   txtQty.SetFocus
End If

CheckOrderLine

End Sub

Private Sub txtSize1_AfterUpdate()

If IsNumeric(txtSize1) And CInt(txtSize1) > 0 Then
   lngS1 = txtSize1
   Else
   MsgBox ("Enter a positive numeric value"), vbExclamation, "VALUE ERROR"
   
   txtSize1 = ""
   txtSize1.SetFocus
   
   lngS1 = 0
End If

CheckOrderLine

End Sub

Private Sub txtSize2_AfterUpdate()

If IsNumeric(txtSize2) And CInt(txtSize2) > 0 Then
   lngS2 = txtSize2
   Else
   MsgBox ("Enter a positive numeric value"), vbExclamation, "VALUE ERROR"
   
   txtSize2 = ""
   txtSize2.SetFocus
   
   lngS2 = 0
End If

CheckOrderLine

End Sub

Private Sub txtGSM_AfterUpdate()

If IsNumeric(txtGSM) And CInt(txtGSM) > 0 Then
   lngGSM = txtGSM
   Else
   MsgBox ("Enter a positive numeric value"), vbExclamation, "VALUE ERROR"
   
   txtGSM = ""
   txtGSM.SetFocus
   
   lngGSM = 0
End If

CheckOrderLine

End Sub

Private Sub txtMarks_AfterUpdate()

txtMarks = Replace(Trim(txtMarks), "  ", " ")

strMarks = txtMarks

CheckOrderLine

End Sub

Private Sub CheckOrderLine()

Dim boolOrderLine As Boolean
Dim boolLineClear As Boolean

boolOrderLine = True
boolLineClear = False

If boolAmendLine = True Then
   Else
   If strProduct <> "" And Range("Holding_OProductsExact") = 1 Then
      boolLineClear = True
      Else
      boolOrderLine = False
   End If
End If

If cbUnit = "" Then
   boolOrderLine = False
   Else
   boolLineClear = True
End If

If txtUnitPrice = "" Then
   boolOrderLine = False
   Else
   boolLineClear = True
End If

If txtQty = "" Then
   boolOrderLine = False
   Else
   boolLineClear = True
End If

If txtSize1 = "" Then
   boolOrderLine = False
   Else
   boolLineClear = True
End If

If boolSize2 = True Then
   If txtSize2 = "" And cbUnit <> "Tonnes" Then
      boolOrderLine = False
      Else
      boolLineClear = True
   End If
End If

If txtGSM = "" Then
   boolOrderLine = False
   Else
   boolLineClear = True
End If

If txtMarks = "" Then
   Else
   boolLineClear = True
End If

btnAdd.Enabled = boolOrderLine
btnClearLine.Enabled = boolLineClear

If strUT <> "" And dblUP > 0 And dblQty > 0 Then
   Select Case strUT
      Case "Linear M", "Sheets", "Sheets/G"
         dblLV = (dblQty * dblUP) / 1000
      
      Case strUT = "Reels", "Tonnes"
         dblLV = dblQty * dblUP
      
      Case "M" & Chr(178)
         dblLV = (dblQty * dblUP) / 100
      
   End Select
   Else
   dblLV = 0
End If

lblLineValue = Format(dblLV, "#,##0.00")
      
If strUT <> "" And dblQty > 0 And lngS1 > 0 And lngGSM > 0 Then
   Select Case strUT
      Case "Linear M"
         dblTonnes = (dblQty * ((lngS1 * lngGSM) / 1000)) / 1000000
                        
      Case "M" & Chr(178)
         dblTonnes = (dblQty * lngGSM) / 1000000
                     
      Case "Reels"
         dblTonnes = ((dblQty * 5000) * (lngS1 / 1000) * lngGSM) / 1000000
              
      Case "Sheets", "Sheets/G"
         If lngS2 > 0 Then
            dblTonnes = (dblQty * (lngS1 / 1000) * (lngS2 / 1000) * lngGSM) / 1000000
            Else
            dblTonnes = 0
         End If
         
      Case "Tonnes"
         dblTonnes = dblQty
      
   End Select
   
   lblTonnes = Format(dblTonnes, "#,##0.000")
   Else
   dblTonnes = 0
   
   lblTonnes = ""
End If

End Sub

Private Sub btnAdd_Click()

Set rngHeader = Range("Holding_OOLHeader")

If boolAmendLine = True Then
   Set rngOL = Range("Holding_OOLStart").Offset(intItem + 1, 0)
   
   rngOL.Offset(0, Application.WorksheetFunction.Match("Qty", rngHeader, 0) - 1) = dblQty
   Else
   cbMill.Enabled = False
   
   Set rngOL = Range("Holding_OOLStart").Offset(Range("Holding_OLinesCount") + 1)
   
   rngOL = Range("Holding_OLinesCount") + 1
   
   rngOL.Offset(0, Application.WorksheetFunction.Match("QTY", rngHeader, 0) - 1) = dblQty
   
   rngOL.Offset(0, Application.WorksheetFunction.Match("PRODUCT", rngHeader, 0) - 1) = strProduct
End If

rngOL.Offset(0, Application.WorksheetFunction.Match("S1", rngHeader, 0) - 1) = lngS1

If boolSize2 = True Then
   rngOL.Offset(0, Application.WorksheetFunction.Match("S2", rngHeader, 0) - 1) = lngS2
   Else
End If

rngOL.Offset(0, Application.WorksheetFunction.Match("GSM", rngHeader, 0) - 1) = lngGSM

Select Case cbUnit
   Case "M" & Chr(178)
      rngOL.Offset(0, Application.WorksheetFunction.Match("PU", rngHeader, 0) - 1) = CCur(lblLineValue / (dblQty * 100))
   
   Case "Sheets", "Sheets/G"
      rngOL.Offset(0, Application.WorksheetFunction.Match("PU", rngHeader, 0) - 1) = CCur(lblLineValue / (dblQty * 1000))
   
   Case Else
      rngOL.Offset(0, Application.WorksheetFunction.Match("PU", rngHeader, 0) - 1) = (dblQty / 1000) * dblUP
   
End Select

rngOL.Offset(0, Application.WorksheetFunction.Match("UP", rngHeader, 0) - 1) = dblUP

rngOL.Offset(0, Application.WorksheetFunction.Match("UT", rngHeader, 0) - 1) = strUT
rngOL.Offset(0, Application.WorksheetFunction.Match("UP", rngHeader, 0) - 1) = dblUP
rngOL.Offset(0, Application.WorksheetFunction.Match("Marks", rngHeader, 0) - 1) = strMarks
rngOL.Offset(0, Application.WorksheetFunction.Match("LV", rngHeader, 0) - 1) = dblLV
rngOL.Offset(0, Application.WorksheetFunction.Match("Tonnes", rngHeader, 0) - 1) = dblTonnes

Sheets("Holding").Calculate

dblOV = Range("Holding_OOrderValue")

lblOrderValue = Format(dblOV, "#,##0.00")

Range("Holding_OProduct") = ""
Range("Holding_OUnit") = ""

lbProducts.Enabled = False
lbProducts.RowSource = ""

boolClearOL = True

txtProduct = ""
cbUnit = ""
txtUnitPrice = ""
txtQty = ""
txtSize1 = ""
txtSize2 = ""
txtSize2.Enabled = False
txtGSM = ""
txtMarks = ""
lblLineValue = ""
lblTonnes = ""

boolClearOL = False

txtProduct.Enabled = True
lbProducts.Enabled = False
cbUnit.Enabled = False
txtUnitPrice.Enabled = False
txtQty.Enabled = False
txtSize1.Enabled = False
txtSize2.Enabled = False
txtGSM.Enabled = False
txtMarks.Enabled = False

btnAdd.Enabled = False
btnClearLine.Enabled = False

lbOrderLines.Locked = False

If boolAmendLine = True Then
   btnAdd.Caption = "ADD LINE"
   
   For intItem = 0 To lbOrderLines.ListCount - 1
      lbOrderLines.Selected(intItem) = False
   Next
   
   boolAmendLine = False
   Else
   Sheets("Holding").Calculate
   
   lbOrderLines.RowSource = strH & Range("D_HoldingOOrderLines").Address
End If

CheckSave

Set rngHeader = Nothing

If Range("Holding_OLinesCount") = 30 Then
   MsgBox ("The maximum number of order lines has been reached (30)." & vbCr & vbCr & "If further order lines are required, an additional Purchase Order will need to be created."), vbExclamation, "MAXIMUM LINES REACHED"
   Else
End If

End Sub

Private Sub btnClearLine_Click()

boolClearOL = True
boolApplyListBox = True

txtProduct = ""
cbUnit = ""
txtUnitPrice = ""
txtQty = ""
lblLineValue = ""
lblTonnes = ""
txtSize1 = ""
txtSize2 = ""
txtSize2.Enabled = False
txtGSM = ""
txtMarks = ""

Range("Holding_OProduct") = ""
Range("Holding_OUnit") = ""

boolClearOL = False
boolApplyListBox = False

btnAdd.Enabled = False
btnClearLine.Enabled = False

Sheets("Holding").Calculate

For intItem = 0 To lbOrderLines.ListCount - 1
   lbOrderLines.Selected(intItem) = False
Next

End Sub

Private Sub lbOrderLines_Click()

If boolAmendLine = True Or BoolDelLine = True Then
   Exit Sub
   Else
End If

btnDelLine.Enabled = False

lbOrderLines.ControlTipText = ""

For intItem = 0 To lbOrderLines.ListCount - 1
   If lbOrderLines.Selected(intItem) = True Then
      btnDelLine.Enabled = True
      
      lbOrderLines.ControlTipText = "DOUBLE CLICK TO AMEND ORDER LINE"
      
      Exit For
      Else
   End If
Next

End Sub

Private Sub lbOrderLines_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim strTonnes As String

Dim intReturn As Integer

Dim dblTonnes As Double

'If txtProduct <> "" Or cbUnit <> "" Or txtUnitPrice <> "" Or txtQty <> "" Or txtSize1 <> "" Or txtSize2 <> "" Or txtGSM <> "" Or txtMarks <> "" Then
'   MsgBox ("Clear any unsaved Order Line data before retrieving existing Order Line data"), vbExclamation, "CLEAR DATA"
'
'   Exit Sub
'   Else
'End If

boolAmendLine = True

With lbOrderLines
   For intItem = 0 To .ListCount - 1
      If .Selected(intItem) = True Then
         intReturn = .List(intItem, 0)
         
         txtProduct.Locked = True
         txtProduct = Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("Product", Range("Holding_OOLHeader"), 0) - 1)
      
         cbUnit.Enabled = True
         cbUnit = Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("UT", Range("Holding_OOLHeader"), 0) - 1)

         txtUnitPrice.Enabled = True
         txtUnitPrice = Format(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("UP", Range("Holding_OOLHeader"), 0) - 1), "#,##0.00")

         txtQty.Enabled = True
         txtQty = Format(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("Qty", Range("Holding_OOLHeader"), 0) - 1), "#,##0.00")

         lblLineValue = Format(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("LV", Range("Holding_OOLHeader"), 0) - 1), "#,##0.00")
         
         strTonnes = Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("Tonnes", Range("Holding_OOLHeader"), 0) - 1)
                  
         lblTonnes = Format(strTonnes, "#,##0.000")
         
         txtSize1.Enabled = True
         txtSize1 = Format(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("S1", Range("Holding_OOLHeader"), 0) - 1), "#,##0")

         If Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("S2", Range("Holding_OOLHeader"), 0) - 1) = "" Then
            txtSize2.Enabled = False
            Else
            txtSize2.Enabled = True
            txtSize2 = Format(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("S2", Range("Holding_OOLHeader"), 0) - 1), "#,##0")
         End If
         
         txtGSM.Enabled = True
         txtGSM = Format(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("GSM", Range("Holding_OOLHeader"), 0) - 1), "#,##0")
         
         txtMarks.Enabled = True
         txtMarks = Replace(Range("Holding_OOLStart").Offset(intReturn, Application.WorksheetFunction.Match("Marks", Range("Holding_OOLHeader"), 0) - 1), " - " & lblTonnes & "t", "")
                          
         btnAdd.Caption = "AMEND LINE"
                          
         Exit For
         Else
      End If
   Next
End With

boolAmendLine = False

lbProducts.RowSource = ""
btnAdd.Enabled = False
btnClearLine.Enabled = True

btnDelLine.Enabled = False

End Sub

Private Sub btnDelLine_Click()

Dim rngMove As Range

Dim intRow As Integer
Dim intRows As Integer
Dim intCols As Integer

Dim boolRowsource As Boolean

BoolDelLine = True
'boolRowsource = True

intCols = Range("Holding_OOLHeader").Columns.Count - 1

Set rngMove = Range(Range("Holding_OOLStart"), Range("Holding_OOLStart").Offset(0, intCols))

With lbOrderLines
   For intItem = 0 To .ListCount - 1
      If .Selected(intItem) = True Then
         intRow = .List(intItem, 0)
         
         If intRow = Range("Holding_OLinesCount") Then
            rngMove.Offset(intRow, 0).ClearContents
            
'            boolRowsource = False
            Else
            intRows = Range("Holding_OLinesCount")
            
            Range(rngMove.Offset(intRow, 0), rngMove.Offset(intRow + (intRows - intRow), 0)).Value = _
               Range(rngMove.Offset(intRow + 1, 0), rngMove.Offset(intRow + (intRows - intRow) + 1, 0)).Value
         End If
         
         Exit For
         Else
      End If
   Next
End With

For intItem = 0 To lbOrderLines.ListCount - 1
   lbOrderLines.Selected(intItem) = False
Next

Set rngMove = Range("Holding_OOLStart").Offset(1, 0)

Do Until rngMove = ""
   If rngMove.Offset(-1, 0) = "#" Then
      rngMove = 1
      Else
      rngMove = rngMove.Offset(-1, 0) + 1
   End If
   
   Set rngMove = rngMove.Offset(1, 0)
Loop

Set rngMove = Nothing

Sheets("Holding").Calculate

If Range("Holding_OLinesCount") = 0 Then
   lbOrderLines.RowSource = ""
   
   btnSave.Enabled = False
   Else
   lbOrderLines.RowSource = strH & Range("D_HoldingOOrderLines").Address
   
   btnSave.Enabled = True
End If

lblOrderValue = Format(Range("Holding_OOrderValue"), "#,##0.00")

BoolDelLine = False

btnDelLine.Enabled = False

End Sub

Private Sub CheckSave()

boolSave = True
boolClear = False

If Range("Holding_OCustomerMatch") = 0 Then
   boolSave = False
   Else
   boolClear = True
End If

If txtOrderNo = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If cbCurr = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If txtCommRate = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If txtDelAddress = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If cbMill = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If lbOrderLines.ListCount = 0 Then
   boolSave = False
   Else
   boolClear = True
End If

If txtPackInfo = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If cbDelTerms = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If cbDelText = "" Then
   boolSave = False
   Else
   boolClear = True
End If

If txtDelDate = "" Then
   If boolDelDate = False Then
      Else
      boolSave = False
   End If
   Else
   boolClear = True
End If

If cbGO = "" Then
   boolSave = False
   Else
   boolClear = True
End If

btnSave.Enabled = boolSave

If boolAmendPO = True Then
   Else
   btnClear.Enabled = boolClear
End If

End Sub

Private Sub btnSave_Click()

frmOrder1New.Hide

If boolAmendPO = True Or boolVerifyPO = True Then
   With rsQueryOrder
      .Fields("Customer_ON") = strON
      .Fields("Commission") = sglComm
      .Fields("Payment_Terms") = strPT
      .Fields("Currency") = strCurr
      .Fields("Delivery_Location") = strDA
      .Fields("Delivery_Text") = strDText
      .Fields("Delivery_Date") = dtDel
      .Fields("Delivery_Terms") = strDTerms
      .Fields("Green_Options") = strGO
      
      If boolVerifyPO = True Then
         .Fields("Verified") = True
         Else
         .Fields("Verified") = False
      End If
      
      .Update
      
      .Close
   End With
   
   Set rsQueryOrder = Nothing
   Else
   Connection

   Set rsQuery = CreateObject("ADODB.Recordset")
   
   strQuery = "SELECT MAX(PO_No) FROM Orders"
   
   With rsQuery
      .Open strQuery, cnConn, adOpenKeyset, adLockOptimistic
   
      lngPO = .Fields("PO_No") + 1
   
      .Close
   End With
   
   dblOV = Range("Holding_OOrderValue")
   
   Set rsQuery = Nothing
   
   Set rsNew = New ADODB.Recordset
   
   With rsNew
      .Open "Orders", cnConn, adOpenKeyset, adLockOptimistic, adCmdTable
   
      .AddNew
   
      .Fields("PO_No") = lngPO
      .Fields("Customer") = strCustomer
      .Fields("Customer_ON") = strON
      .Fields("Commission") = sglComm
      .Fields("Payment_Terms") = strPT
      .Fields("Currency") = strCurr
      .Fields("Mill") = strMill
      .Fields("Delivery_Location") = strDA
      .Fields("Delivery_Text") = strDText
      .Fields("Delivery_Date") = dtDel
      .Fields("Delivery_Terms") = strDTerms
      .Fields("Green_Options") = strGO
      
      .Update
      
      .Close
   End With
   
   Set rsNew = Nothing
End If

If boolAmendPO = True Or boolVerifyPO = True Then
   rsQueryLines.Close
   
   Set rsQueryLines = Nothing
   
   Set rsQuery = CreateObject("ADODB.Recordset")
   
   strQuery = "DELETE FROM OrderLines WHERE PO_No = '" & lngPO & "'"
   
   cnConn.Execute strQuery
   
   Set rsQuery = Nothing
   Else
End If
   
Set rngOL = Range("Holding_OOLStart").Offset(1, 0)

Set rngHeader = Range("Holding_OOLHeader")

Do Until rngOL = ""
   Set rsNew = New ADODB.Recordset
   
   With rsNew
      .Open "OrderLines", cnConn, adOpenKeyset, adLockOptimistic, adCmdTable
   
      .AddNew
         
      .Fields("PO_No") = lngPO
      .Fields("Product") = rngOL.Offset(0, Application.WorksheetFunction.Match("Product", rngHeader, 0) - 1)
      .Fields("Unit_Type") = rngOL.Offset(0, Application.WorksheetFunction.Match("UT", rngHeader, 0) - 1)
      .Fields("Unit_Price") = rngOL.Offset(0, Application.WorksheetFunction.Match("UP", rngHeader, 0) - 1)
      .Fields("Quantity") = rngOL.Offset(0, Application.WorksheetFunction.Match("Qty", rngHeader, 0) - 1)
      .Fields("Line_Value") = rngOL.Offset(0, Application.WorksheetFunction.Match("LV", rngHeader, 0) - 1)
      .Fields("Tonnes") = rngOL.Offset(0, Application.WorksheetFunction.Match("Tonnes", rngHeader, 0) - 1)
      .Fields("Size1") = rngOL.Offset(0, Application.WorksheetFunction.Match("S1", rngHeader, 0) - 1)
      .Fields("Size2") = rngOL.Offset(0, Application.WorksheetFunction.Match("S2", rngHeader, 0) - 1)
      .Fields("GSM") = rngOL.Offset(0, Application.WorksheetFunction.Match("GSM", rngHeader, 0) - 1)
      .Fields("Marks") = rngOL.Offset(0, Application.WorksheetFunction.Match("Marks", rngHeader, 0) - 1)
      .Fields("Per_Unit") = rngOL.Offset(0, Application.WorksheetFunction.Match("PU", rngHeader, 0) - 1)
      
      .Update
      
      .Close
   End With
   
   Set rsNew = Nothing
   
   Set rngOL = rngOL.Offset(1, 0)
Loop

cnConn.Close

Set cnConn = Nothing

Range("MO_PT") = strPT
Range("MO_PONo") = lngPO
Range("MO_ON") = strON

If dtDel > 0 Then
   Range("MO_DText") = strDText & Format(dtDel, " dd mmm yy")
   Else
   Range("MO_DText") = strDText
End If

Range("MO_PI") = strPI

End Sub

Private Sub btnClear_Click()

Dim mbConfirm

If boolAmendPO = False Then
   mbConfirm = MsgBox("This will completely clear the Mill Order form." & vbCr & vbCr & _
      "Click 'OK' to confirm or 'CANCEL' to retain all the current form entries.", vbQuestion + vbOKCancel, "CONFIRM CLEAR")
      
   If mbConfirm = vbOK Then
      boolClearForm = True
      
      For Each ctlControl In frmOrder1New.Controls
         If TypeName(ctlControl) = "TextBox" Or TypeName(ctlControl) = "ComboBox" Then
            ctlControl = ""
            Else
         End If
      Next
           
      Range("Holding_OCustomer") = ""
      Range("Holding_ODA") = ""
      Range("Holding_OMill") = ""
      Range("Holding_OProduct") = ""
      Range("Holding_OUnit") = ""
      Range("Holding_OOLClear").Clear
      
      cbMill.Enabled = True
      
      lbCustomer.RowSource = ""
      lbDelAddress.RowSource = ""
      lbProducts.RowSource = ""
      lbOrderLines.RowSource = ""
      
      lblDelAddress = ""
      lblLineValue = ""
      lblTonnes = ""
      lblOrderValue = ""
      
      txtSize2.Enabled = False
      txtDelDate.Enabled = False
      
      btnAdd.Enabled = False
      btnClearLine.Enabled = False
      btnDelLine.Enabled = False
      btnSave.Enabled = False
      btnClear.Enabled = False
      
      boolClearForm = False
      Else
   End If
   Else
   mbConfirm = MsgBox("Click 'OK' to confirm the Purchase Order has been verified or 'CANCEL' to return to the Purchase Order view.", vbQuestion + vbOKCancel, "CONFIRM VERIFICATION")
      
   If mbConfirm = vbOK Then
      frmOrder1New.Hide
      Else
   End If

End If

End Sub

Private Sub btnCancel_Click()

boolExit = True

frmOrder1New.Hide

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode = vbFormControlMenu Then
   Cancel = True
   
   btnCancel_Click
   Else
End If

End Sub

mikeymay · Jun 13, 2022

As stated in my initial post, no code execute to return the error message - As soon as I click away from the control, the error pops up without attempting to 'run' any code

mikeymay · Jun 13, 2022

After another dig around the web, it seems this has solved the issue

VBA Code:

Private Sub ComboBox1_Enter()
    'Turn on MatchRequired when the user enters the ComboBox Control
    Me.ComboBox1.MatchRequired = True
End Sub



Private Sub ComboBox1_Change()
    If Me.ComboBox1.Value = "" Then
        'Match not required if zero lenght string
        Me.ComboBox1.MatchRequired = False
    Else
        'Match is required if other than zero length string
        Me.ComboBox1.MatchRequired = True
    End If
End Sub

Code was found on the Microsoft Dev Centre site and thanks to OssieMac for the code.

User Form ComboBox - Invalid Property Value

mikeymay

Well-known Member

Excel Facts

6StringJazzer

Well-known Member

mikeymay

Well-known Member

mikeymay

Well-known Member

mikeymay

Well-known Member

Similar threads

Forum statistics

Share this page

User Form ComboBox - Invalid Property Value

mikeymay

Well-known Member

Excel Facts

6StringJazzer

Well-known Member

mikeymay

Well-known Member

mikeymay

Well-known Member

mikeymay

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock