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
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
