Error: Application-defined or Object-defined error

Pinkster69

New Member
Joined
Jun 19, 2012
Messages
48
Hi Guys,

I have a an error "Application-defined or Object-defined error" popping up and it's wrecking my head trying to solve it!
Basicly I have a ListBox "DataListBox2" which when populated I click on any one line in the list box to get info displayed on the Userform "CustomerDataUserForm" which gets its info from worksheet "Sheets("Sheet2")".
I know which part of the error is the culprit, the "GetFlag" in the Sub "DataListBox2_Click()", which searches another worksheet "Sheets(DataSheet)" for the Value in "TodaysDate TextBox" & the value in "SKUNumberTextBox2 Combobox".

I use the "GetFlag" Sub to see if the Item is available, which shows up on a Message Box when available for the period needed when I click on any of the List Items in the ListBox. If I leave out the "GetFlag" from the procedure everything works well except naturally I don't get the Message Box telling me if the item is available or not. Another thing is that when I get the error and I press OK to get rid of it everything works as it should. The only annoying thing is that the error pops up all the time.
I have attached only the parts of the code that pertains to my problem as I have a lot of code doing other things on the UserForm and I am hoping someone can solve this for me.

Many thanks

Pinkster69







Code:
Const DataSheet = "Data"        ' Sheet with data
Const HatDates = "G2:AWK2"      ' Address of dates
Const HatSKUs = "A2:A1000"       ' Address of SKUs
Const FLAGGEDTEXT = "NOT AVAILABLE"     ' Text to display
Const FLAGGEDTEXT2 = "AVAILABLE"     ' Text to display id not Available
Const FLAG = 1                  ' flag
    
Dim strQtyDaysBefore
Dim strTotalCost As Currency


Dim MyData     As Range
Dim c          As Range
Dim rFound     As Range
Dim r          As Long
Dim rng        As Range

Dim rng2        As Range
Dim c2          As Range
Dim r2          As Long

Dim imgFolder  As String        ' sub directory containing images
Dim sFileName  As String        'image name
Dim oCtrl      As MSForms.Control






Private Sub GetFlag()      ' display "Available or Not Available" if flagged    
    On Local Error GoTo errors
    
    
    With Sheets(DataSheet)
        Me.TextBox3 = ""
        Set DateFound = .Range(HatDates).Find(what:=TodaysDate.Value)
        Set SKUFound = .Range(HatSKUs).Find(what:=SKUNumberTextBox2.Value)
        
        '##################################################################################
        'If .Cells(SKUFound.Row, DateFound.Column) = FLAG Then Me.TextBox3 = FLAGGEDTEXT
        'If .Cells(SKUFound.Row, DateFound.Column) = "" Then Me.TextBox3 = FLAGGEDTEXT2
        '#################################################################################
        
        'It resizes the test cell .Cells(SKUFound.Row, DateFound.Column) to "X" as set bt the "ExtraDaysTextBox.Value" columns wide .Resize(, ExtraDaysTextBox.Value) and then counts if any of those
        'five cells contain a 1 or FLAG
        If WorksheetFunction.CountIf(.Cells(SKUFound.Row, DateFound.Column).Resize(, QtyDaysBeforeTextbox.Value), FLAG) > 0 Then Me.TextBox3 = FLAGGEDTEXT
        
        'It resizes the test cell .Cells(SKUFound.Row, DateFound.Column) to "X" as set bt the "ExtraDaysTextBox.Value" columns wide .Resize(, ExtraDaysTextBox.Value) and then counts if any of those
        'five cells contain a "0" or are blank
        If WorksheetFunction.CountIf(.Cells(SKUFound.Row, DateFound.Column).Resize(, QtyDaysBeforeTextbox.Value), FLAG) < 1 Then Me.TextBox3 = FLAGGEDTEXT2
        
    End With
    
Exit Sub
    
errors:
    MsgBox "Error: " & Err.Description
    
End Sub








Private Sub DataListBox2_Click()




  'Allows you to click on the items listed in the ListBox and the corrosponding Values displayed in the TextBoxes etc displayed on the Userform.
    If Me.DataListBox2.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    
    ElseIf Me.DataListBox2.ListIndex >= 1 Then    'User has selected
        r = Me.DataListBox2.ListIndex


        With Me
            .BookingNoTextBox2.Value = DataListBox2.List(r, 1)
            .CurioCardTextBox2.Value = DataListBox2.List(r, 2)
            .MobileTextBox2.Value = DataListBox2.List(r, 6)
            .FirstNameTextBox2.Value = DataListBox2.List(r, 3)
            .LastNameTextBox2.Value = DataListBox2.List(r, 4)
            .NotesTextBox.Value = DataListBox2.List(r, 7)
            .SKUNumberTextBox2.Value = DataListBox2.List(r, 8)
            .ColourTextBox2.Value = DataListBox2.List(r, 9)
            .HireDaysTextBox2.Value = DataListBox2.List(r, 14)
            .DaysOverdueTextBox2.Value = DataListBox2.List(r, 13)
            .DepositPaidTextBox2.Value = DataListBox2.List(r, 17)
            .TotalHirePriceTextBox2.Value = DataListBox2.List(r, 18)
            .BalancePaidTextBox2.Value = DataListBox2.List(r, 21)
            
            .DueBackDayLabel = Format(DataListBox2.List(r, 12), "dddd")
            .DueBackDate3Label = Format(DataListBox2.List(r, 12), "dd/mm/yyyy")
            .RentalPriceTextBox2 = DataListBox2.List(r, 15)
            
            .DueForReturnDayLabel = Format(DataListBox2.List(r, 12), "dddd")
            .DueForReturnDateLabel = Format(DataListBox2.List(r, 12), "dd/mm/yyyy")
            
            .WasDueBackDayLabel = Format(DataListBox2.List(r, 12), "dddd")
            .WasDueBackDateLabel = Format(DataListBox2.List(r, 12), "dd/mm/yyyy")
            
            .ItemPickUpDayLabel = Format(DataListBox2.List(r, 11), "dddd")
            .ItemPickUpDateLabel = Format(DataListBox2.List(r, 11), "dd/mm/yyyy")
            
            .CollectionDateSerialTextBox.Value = DataListBox2.List(r, 22)   'Serial Date for Collection date so as to sort out problem with "Not Collected" indication.
            .TodaysDateSerialTextBox.Value = DataListBox2.List(r, 23)       'Serial Date for Todyas date so as to sort out problem with "Not Collected" indication.
  
      
            .QtyDaysBeforeTextbox.Value = DataListBox2.List(r, 22) - DataListBox2.List(r, 23)
           
    
            sFileName = DataListBox2.List(r, 10)
            
            
          
        
        End With
        
        
        ' Displays the Picture of the item when the Listbox is clicked
            LoadPic
    
        'Calculates the Overdue Fee when the Listbox is clicked
            OverdueFeeTextBox.Value = HireCostPerDayTextBox.Value * DaysOverdueTextBox2
            OverdueFeeTextBox.Text = Format(OverdueFeeTextBox.Text, "€#,##0.00")
        
        
    
        'When any item on the ListBox is selected the code will check if the Balance has been paid "Cell 21 of Active row" = BalancePaidTextBox2 and display
        'the corresponding items on the USerform On/Off, displayed or not Displayed etc.
                If DataListBox2.List(r, 21) = "" Then
                
                'Displays Item Available or Not in Textbox3 if a positive number, due to error if a negative number
                    If QtyDaysBeforeTextbox.Value < 0 Then
                        QtyDaysBeforeTextbox = ""
                        TextBox3.Value = ""
                
                    Else

'##########################     Here is the Problem       ##############################################
 
                       GetFlag

'#########################################################################################                                
                    End If
                
                
                
          
            
                    'Gives a Warning if Todays Date is less that the Pick Up Date so as to indicate that there is an extra charge for picking the Hire Item
                    'up early.
                    
                    Dim strMyCollectionDate As Date
                    strMyCollectionDate = DataListBox2.List(r, 22)
                    
                    'Calculates the Number of Days before pick up and the cost of the extra days to pick up early!
                    Dim strQtyDaysBefore
                    strQtyDaysBefore = DataListBox2.List(r, 22) - DataListBox2.List(r, 23)
                    QtyDaysBeforeTextbox.Value = strQtyDaysBeforeTextbox
                    
                    'Calculates the Cost Per Day, Takes into account if the customer has discount "Curio Card"
                    Dim strCostPerDay
                    strCostPerDay = DataListBox2.List(r, 18) / DataListBox2.List(r, 14)
                    
                    'Calculates the Extra Costs involved for the customer
                    Dim strExtraCost
                    strExtraCost = Format(strCostPerDay * strQtyDaysBefore, "€#,##0.00")
                    
                    
                    'Calculates the Total Costs involved = Norm Costs + Extra Costs
                    'For the numbers to add you have to declare them as "Currency" to get the exact amount or integers that round the values up!!
                    Dim strExtraCost2 As Currency
                    strExtraCost2 = strExtraCost
                    Dim strNormHireCost As Currency
                    strNormHireCost = DataListBox2.List(r, 18)
                    
                    Dim strTotalCost As Currency
                    strTotalCost = strExtraCost2 + strNormHireCost
                    
                    'Had to Format strTotalCost this way as setting it to "As Currency" does not Format it
                    Dim strTotalCost2
                    strTotalCost2 = Format(strTotalCost, "€#,##0.00")
                    
                    'Enters the Total cost of the Extra days + the Norm 5 Days Rental into strTotalCost2TextBox
                    strTotalCost2TextBox.Value = strTotalCost2
                    
                    'Displays Available or Not Available on the MsgBox
                    Dim strTextBox3
                    strTextBox3 = TextBox3
                    
                    
                    
                    
                    If TextBox3 = "NOT AVAILABLE" Then
                        msgresponce = MsgBox("Warning! ....  This hire item CANNOT be collected early as it is               NOT AVAILABLE, it is Already Booked!  ", vbCritical)
                                       
                    Else
                       
                        'If TextBox3 says "AVAILABLE" Then
                        If DataListBox2.List(r, 23) < DataListBox2.List(r, 22) Then
                        
                            'Calulates the amount of days before pick up of Hire Item
                                    QtyDaysBeforeTextbox.Value = DataListBox2.List(r, 22) - DataListBox2.List(r, 23)
                            
                            Select Case MsgBox("Warning! ....  Item is not due for Collection untill    " & strMyCollectionDate & "           There will be an Extra Charge of    " & strExtraCost & "     to pick up this Item early,                                                                                                                                  Total Cost of Hire will be    " & strTotalCost2 & "    and is   " & strTextBox3 & "                                                                                                                                                             Click the YES to proceed or NO to Exit ", vbYesNo Or vbExclamation)
                                'BalancePaidTextBox2.Value = strExtraCost + DataListBox2.List(r, 18)
                    
                                Case vbYes
                                   'Do Something
                                                              
                                Case vbNo
                                   'Do nothing
                                
                            End Select
                       
                        End If
                        
                    End If
                                       

        
        
        
                    Label23.Visible = True
                    Label23.ForeColor = &HC000&
                    BalancePaidTextBox2.Visible = True
                    BalancePaidTextBox2.BorderColor = &HC000&
                    BalancePaidLabel.Visible = True
                    BalancePaidLabel.ForeColor = &HC000&
                    BalancePaidLabel.BorderColor = &HC000&
                    BalancePaidLabel = "Pay Balance"
        
                    BalancePaidTextBox2.Value = TotalHirePriceTextBox2.Value
                    'BalancePaidTextBox2.SetFocus
                    
                    
                    If TextBox3 = "NOT AVAILABLE" Then
                    
                        PayBalanceCommandButton.Enabled = False
                        ReturnCommandButton.Enabled = True
                    Else
                        PayBalanceCommandButton.Enabled = True
                        ReturnCommandButton.Enabled = False
                        FindCommandButton.Enabled = False
                    End If
                    
                    DueBackLabel.Visible = True
                    DueBackDayLabel.Visible = True
                    DueBackDate3Label.Visible = True
                    
                    DueForReturnLabel.Visible = False
                    DueForReturnDayLabel.Visible = False
                    DueForReturnDateLabel.Visible = False
  
                Else
    
    
    
                    Label23.Visible = False
                    Label23.ForeColor = &H0&
                    BalancePaidTextBox2.Visible = False
                    BalancePaidLabel.Visible = True
                    BalancePaidTextBox2.BorderColor = &H808080
                    BalancePaidLabel.ForeColor = &HFF8080
                    BalancePaidLabel.BorderColor = &H80000006
                    BalancePaidLabel = "Balance Paid"
        
                    PayBalanceCommandButton.Enabled = False     'De-Activate Pay Balance Button
                    ReturnCommandButton.Enabled = True          'Activate ReturnCommandButton
                    FindCommandButton.Enabled = False
                    
                    DueBackLabel.Visible = False
                    DueBackDayLabel.Visible = False
                    DueBackDate3Label.Visible = False
                    
                    DueForReturnLabel.Visible = True
                    DueForReturnDayLabel.Visible = True
                    DueForReturnDateLabel.Visible = True
        
                    QtyDaysBeforeTextbox = ""
                    TextBox3.Value = ""
               
                End If
                
                
         'When the item is overdue the code displays "Overdue" and changes certain Textboxes & Labels to the colour red
                If DataListBox2.List(r, 13) >= 1 Then
                    Label28.Visible = True
                    Label28.Left = 486
                    Label28.Top = 144
                    Label28.ForeColor = &HFF&
                    DaysOverdueTextBox2.BorderColor = &HFF&
                    ExtraDaysLabel.ForeColor = &HFF&
            
                    OverdueFeeTextBox.Visible = True
                    OverdueFeeTextBox.Left = 462
                    OverdueFeeTextBox.Top = 156
            
                    BalancePaidLabel.Visible = True
                    BalancePaidLabel.ForeColor = &HFF&
                    BalancePaidLabel.BorderColor = &HFF&
                    BalancePaidLabel = "Overdue"
            
                    DueBackRedLabel.Visible = True
                    DueBackRedLabel.Left = 12
                    DueBackRedLabel.Top = 384
            
            
                    WasDueBackDayLabel.Visible = True
                    WasDueBackDateLabel.Visible = True
           
            
                    WasDueBackDayLabel.Left = 270
                    WasDueBackDayLabel.Top = 384
                    WasDueBackDateLabel.Left = 426
                    WasDueBackDateLabel.Top = 384
                            
                
                    'If QtyDaysBeforeTextbox.Value < 0 Then
                        'QtyDaysBeforeTextbox = ""
                        'TextBox3.Value = ""
                    'End If
            
                Else
        
        
                    Label28.Visible = False
                    OverdueFeeTextBox.Visible = False
                    WasDueBackDayLabel.Visible = False
                    WasDueBackDateLabel.Visible = False
                    DueBackRedLabel.Visible = False
                    DaysOverdueTextBox2.BorderColor = &H8000000C
                    ExtraDaysLabel.ForeColor = &H80000006
                    
                    
                End If
                
                
                
                'Not Collected,If the Collection Date is greater than the Current Date and there is NO Payment Date then "Not Collected" is displayed
                


                If DataListBox2.List(r, 22) < DataListBox2.List(r, 23) And DataListBox2.List(r, 20) = "" Then
                    
                    
                    'Calulates the amount of days before pick up of Hire Item
                    QtyDaysBeforeTextbox.Value = DataListBox2.List(r, 22) - DataListBox2.List(r, 23)
                    
                    Label23.Visible = True
                    Label23.ForeColor = &HC000C0
                    BalancePaidTextBox2.Visible = True
                    BalancePaidTextBox2.BorderColor = &HC000C0
                    
                    
                    
                    BalancePaidLabel.Visible = True
                    BalancePaidLabel.ForeColor = &HC000C0
                    BalancePaidLabel.BorderColor = &HC000C0
                    BalancePaidLabel = "Not Collected"
            
                    ItemPickUpLabel.Visible = True
                    ItemPickUpLabel.Left = 12
                    ItemPickUpLabel.Top = 384
            
            
                    ItemPickUpDayLabel.Visible = True
                    ItemPickUpDateLabel.Visible = True
           
            
                    ItemPickUpDayLabel.Left = 270
                    ItemPickUpDayLabel.Top = 384
                    ItemPickUpDateLabel.Left = 426
                    ItemPickUpDateLabel.Top = 384
                    
                    'Label23.Visible = False
                    'BalancePaidTextBox2.Visible = False
                    
                    'PayBalanceCommandButton.Enabled = False     'De-Activate Pay Balance Button
                    ReturnCommandButton.Enabled = True          'Activate ReturnCommandButton
                    FindCommandButton.Enabled = False
                    
                    Label28.Visible = False
                    OverdueFeeTextBox.Visible = False
                    DaysOverdueTextBox2.BackColor = &H80000004
                    DaysOverdueTextBox2.BorderColor = &H8000000C
                    DaysOverdueTextBox2.ForeColor = &H80000004
                    ExtraDaysLabel.BackColor = &H8000000E
                    ExtraDaysLabel.ForeColor = &H80000006
                    
                   
                  'If QtyDaysBeforeTextbox.Value < 0 Then
                        QtyDaysBeforeTextbox = ""
                        TextBox3.Value = ""
                  'End If
            
                Else
        
        
                   
                    ItemPickUpLabel.Visible = False
                    ItemPickUpDayLabel.Visible = False
                    ItemPickUpDateLabel.Visible = False
                
                    'Calulates the amount of days before pick up of Hire Item
                    'QtyDaysBeforeTextbox.Value = DataListBox2.List(r, 22) - DataListBox2.List(r, 23)
                    
                   
                   
            
                End If
                
                
    End If
    
    
End Sub
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Pinkster69

New Member
Joined
Jun 19, 2012
Messages
48
Hi Guys did a bit more troubleshooting and found the actual line thats causing the problem. Its in the "Private Sub GetFlag()" in the following line...

If WorksheetFunction.CountIf(.Cells(SKUFound.Row, DateFound.Column).Resize(, QtyDaysBeforeTextbox.Value), FLAG) > 0 Then Me.TextBox3 = FLAGGEDTEXT

I am missing something simple I guess so any help with this guys I would really really appreciate it as its wrecking my head!! lol

regards

Pinkster69
 

Watch MrExcel Video

Forum statistics

Threads
1,122,737
Messages
5,597,826
Members
414,180
Latest member
Sir Khaya

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
Top