L
ll
Hi,
I am working on the code below, in assigning the value of a variable to
a cell. I keep getting the "run time error 1004"towards the bottom of
the code (below):
<Sheets("Sheet1").Cells(1, 26).Value = d>
I've tried removing the d variable reference but then the error shifts
to the line above where this line was.
Any ideas?
Thanks again,
Louis
----------------------------
Private Sub UserForm_Initialize()
Dim MyUniqueList, MyUniqueList2, MyUniqueList3, MyUniqueList4,
MyUniqueList5 As Variant, i As Long
'///cmdClearCell invisible until after first entry is made
cmdClearCell.Visible = False
'////course combo box setup
'Set up primary (first) combo box (cboCourse)
With Me.cboCourse
..Clear ' clear the listbox content
MyUniqueList = UniqueItemList(Range("Sheet3!A1:A300"), True)
For i = 1 To UBound(MyUniqueList)
..AddItem MyUniqueList(i)
Next
i = 0
..ListIndex = 0 ' select the first item
End With
'////email combo box setup
With Me.cboEmail
..Clear ' clear the listbox content
MyUniqueList5 = UniqueItemList(Range("Sheet2!E1:E300"), True)
For i = 1 To UBound(MyUniqueList5)
..AddItem MyUniqueList5(i)
Next
i = 0
..ListIndex = 0 ' select the first item
End With
'///////////
cboCourse.SetFocus
'///txtUserName.Value = Application.UserName
'txtName.Value = ""
txtName.Value = c
txtDateCheckedOut.Value = ""
Me.cboCourse2.Visible = False
Me.Label4.Visible = False
End Sub
Private Function UniqueItemList(InputRange As Range, _
HorizontalList As Boolean) As Variant
Dim cl As Range, cUnique As New Collection, i As Long, uList() As
Variant
Application.Volatile
On Error Resume Next
For Each cl In InputRange
If cl.Formula <> "" Then
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl
UniqueItemList = ""
If cUnique.Count > 0 Then
ReDim uList(1 To cUnique.Count)
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
UniqueItemList = uList
If Not HorizontalList Then
UniqueItemList = _
Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function
Private Sub cboCourse_Change()
'Check if ListIndex = 0 (first option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 0 Then
Label4.Visible = False
Me.cboCourse2.Visible = False
..Clear ' Clear the list box content
End If
End With
'Check if ListIndex = 1 or "all" (second option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 1 Then
Me.Label4.Visible = True
Me.cboCourse2.Visible = True
..Clear ' Clear the list box content
'////Edit range below
'the variable below is to populate the combo box
MyUniqueList2 = UniqueItemList(Sheet3.Range("B1:B385"), True)
'//added below line
'//MyUniqueListTestA = UniqueItemList(Sheet1.Range("C8:C385"), True)
'loop below for combo box
For i = 1 To UBound(MyUniqueList2)
'//added below line
'//If MyUniqueList2(i).Value <> MyUniqueListTestA(i).Value Then
..AddItem MyUniqueList2(i)
'//End If
Next i
'i = 0
'loop below for accurate row count
Me.cboCourse2.ListIndex = 0 'select the first item
End If
End With
'Check if ListIndex = 2 or "A-M Books" (third option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 2 Then
Me.Label4.Visible = True
Me.cboCourse2.Visible = True
..Clear ' Clear the list box content
'////Edit range below
'the variable below is to populate the combo box
MyUniqueList3 = UniqueItemList(Sheet3.Range("B1:B10"), True)
'loop below for combo box
For i = 1 To UBound(MyUniqueList3)
..AddItem MyUniqueList3(i)
Next i
'i = 0
'loop below for accurate row count
Me.cboCourse2.ListIndex = 0 'select the first item
End If
End With
'Check if ListIndex = 3 or "N-Z Books" (third option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 3 Then
Me.Label4.Visible = True
Me.cboCourse2.Visible = True
..Clear ' Clear the list box content
'////Edit range below
'the variable below is to populate the combo box
MyUniqueList4 = UniqueItemList(Sheet3.Range("B11:B80"), True)
'loop below for combo box
For i = 1 To UBound(MyUniqueList4)
..AddItem MyUniqueList4(i)
Next i
'i = 0
'loop below for accurate row count
Me.cboCourse2.ListIndex = 0 'select the first item
End If
End With
End Sub
Public Sub cmdOK_Click()
'Set cmdClearCell button to visible
cmdClearCell.Visible = True
ActiveWorkbook.Sheets("Sheet1").Activate
ActiveWorkbook.Sheets("Sheet1").Unprotect Password:="girl"
If cboCourse.ListIndex = 0 Then
MsgBox "You Must Select A Course Category"
Exit Sub
End If
If cboEmail.ListIndex = 0 Then
MsgBox "You Must Enter a Valid Email Address"
Exit Sub
End If
If txtDateCheckedOut.Value = "" Then
MsgBox "You Must Click A Date"
Exit Sub
End If
Dim i As Integer
Dim d As Integer
d = 1
For i = 8 To 3000
Cells(1, 26).Clear
If i = d + 1 Then
Exit Sub
End If
If Sheets("Sheet1").Cells(i, 1).Value = "" Then
Sheets("Sheet1").Cells(i, 1).Value = frmBkCheckout.txtName.Value
Sheets("Sheet1").Cells(i, 2).Value = frmBkCheckout.cboEmail.Value
Sheets("Sheet1").Cells(i, 3).Value = frmBkCheckout.cboCourse2.Value
Sheets("Sheet1").Cells(i, 4).Value =
frmBkCheckout.txtDateCheckedOut.Value
d = i
Sheets("Sheet1").Cells(1, 26).Value = d
End If
Next
ActiveWorkbook.Sheets("Sheet1").Protect Password:="girl"
ActiveWorkbook.Sheets("Sheet2").Protect Password:="girl"
ActiveWorkbook.Save
End Sub
Private Sub cboEmail_Change()
'get employee name (by looking through table)
'for display on form
Dim u As Integer
For u = 1 To 300
If UCase(Sheet2.Cells(u, 4).Value) =
UCase(frmBkCheckout.cboEmail.Value) Then
frmBkCheckout.txtName.Value = Sheet2.Cells(u, 3).Value
frmBkCheckout.txtUserName.Value = Sheet2.Cells(u, 1).Value
End If
Next u
'end get employee name
End Sub
Private Sub cmdClearForm_Click()
Call UserForm_Initialize
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub txtDateTaken_Change()
End Sub
I am working on the code below, in assigning the value of a variable to
a cell. I keep getting the "run time error 1004"towards the bottom of
the code (below):
<Sheets("Sheet1").Cells(1, 26).Value = d>
I've tried removing the d variable reference but then the error shifts
to the line above where this line was.
Any ideas?
Thanks again,
Louis
----------------------------
Private Sub UserForm_Initialize()
Dim MyUniqueList, MyUniqueList2, MyUniqueList3, MyUniqueList4,
MyUniqueList5 As Variant, i As Long
'///cmdClearCell invisible until after first entry is made
cmdClearCell.Visible = False
'////course combo box setup
'Set up primary (first) combo box (cboCourse)
With Me.cboCourse
..Clear ' clear the listbox content
MyUniqueList = UniqueItemList(Range("Sheet3!A1:A300"), True)
For i = 1 To UBound(MyUniqueList)
..AddItem MyUniqueList(i)
Next
i = 0
..ListIndex = 0 ' select the first item
End With
'////email combo box setup
With Me.cboEmail
..Clear ' clear the listbox content
MyUniqueList5 = UniqueItemList(Range("Sheet2!E1:E300"), True)
For i = 1 To UBound(MyUniqueList5)
..AddItem MyUniqueList5(i)
Next
i = 0
..ListIndex = 0 ' select the first item
End With
'///////////
cboCourse.SetFocus
'///txtUserName.Value = Application.UserName
'txtName.Value = ""
txtName.Value = c
txtDateCheckedOut.Value = ""
Me.cboCourse2.Visible = False
Me.Label4.Visible = False
End Sub
Private Function UniqueItemList(InputRange As Range, _
HorizontalList As Boolean) As Variant
Dim cl As Range, cUnique As New Collection, i As Long, uList() As
Variant
Application.Volatile
On Error Resume Next
For Each cl In InputRange
If cl.Formula <> "" Then
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl
UniqueItemList = ""
If cUnique.Count > 0 Then
ReDim uList(1 To cUnique.Count)
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
UniqueItemList = uList
If Not HorizontalList Then
UniqueItemList = _
Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function
Private Sub cboCourse_Change()
'Check if ListIndex = 0 (first option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 0 Then
Label4.Visible = False
Me.cboCourse2.Visible = False
..Clear ' Clear the list box content
End If
End With
'Check if ListIndex = 1 or "all" (second option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 1 Then
Me.Label4.Visible = True
Me.cboCourse2.Visible = True
..Clear ' Clear the list box content
'////Edit range below
'the variable below is to populate the combo box
MyUniqueList2 = UniqueItemList(Sheet3.Range("B1:B385"), True)
'//added below line
'//MyUniqueListTestA = UniqueItemList(Sheet1.Range("C8:C385"), True)
'loop below for combo box
For i = 1 To UBound(MyUniqueList2)
'//added below line
'//If MyUniqueList2(i).Value <> MyUniqueListTestA(i).Value Then
..AddItem MyUniqueList2(i)
'//End If
Next i
'i = 0
'loop below for accurate row count
Me.cboCourse2.ListIndex = 0 'select the first item
End If
End With
'Check if ListIndex = 2 or "A-M Books" (third option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 2 Then
Me.Label4.Visible = True
Me.cboCourse2.Visible = True
..Clear ' Clear the list box content
'////Edit range below
'the variable below is to populate the combo box
MyUniqueList3 = UniqueItemList(Sheet3.Range("B1:B10"), True)
'loop below for combo box
For i = 1 To UBound(MyUniqueList3)
..AddItem MyUniqueList3(i)
Next i
'i = 0
'loop below for accurate row count
Me.cboCourse2.ListIndex = 0 'select the first item
End If
End With
'Check if ListIndex = 3 or "N-Z Books" (third option in combo box)
With Me.cboCourse2
'.Clear
If Me.cboCourse.ListIndex = 3 Then
Me.Label4.Visible = True
Me.cboCourse2.Visible = True
..Clear ' Clear the list box content
'////Edit range below
'the variable below is to populate the combo box
MyUniqueList4 = UniqueItemList(Sheet3.Range("B11:B80"), True)
'loop below for combo box
For i = 1 To UBound(MyUniqueList4)
..AddItem MyUniqueList4(i)
Next i
'i = 0
'loop below for accurate row count
Me.cboCourse2.ListIndex = 0 'select the first item
End If
End With
End Sub
Public Sub cmdOK_Click()
'Set cmdClearCell button to visible
cmdClearCell.Visible = True
ActiveWorkbook.Sheets("Sheet1").Activate
ActiveWorkbook.Sheets("Sheet1").Unprotect Password:="girl"
If cboCourse.ListIndex = 0 Then
MsgBox "You Must Select A Course Category"
Exit Sub
End If
If cboEmail.ListIndex = 0 Then
MsgBox "You Must Enter a Valid Email Address"
Exit Sub
End If
If txtDateCheckedOut.Value = "" Then
MsgBox "You Must Click A Date"
Exit Sub
End If
Dim i As Integer
Dim d As Integer
d = 1
For i = 8 To 3000
Cells(1, 26).Clear
If i = d + 1 Then
Exit Sub
End If
If Sheets("Sheet1").Cells(i, 1).Value = "" Then
Sheets("Sheet1").Cells(i, 1).Value = frmBkCheckout.txtName.Value
Sheets("Sheet1").Cells(i, 2).Value = frmBkCheckout.cboEmail.Value
Sheets("Sheet1").Cells(i, 3).Value = frmBkCheckout.cboCourse2.Value
Sheets("Sheet1").Cells(i, 4).Value =
frmBkCheckout.txtDateCheckedOut.Value
d = i
Sheets("Sheet1").Cells(1, 26).Value = d
End If
Next
ActiveWorkbook.Sheets("Sheet1").Protect Password:="girl"
ActiveWorkbook.Sheets("Sheet2").Protect Password:="girl"
ActiveWorkbook.Save
End Sub
Private Sub cboEmail_Change()
'get employee name (by looking through table)
'for display on form
Dim u As Integer
For u = 1 To 300
If UCase(Sheet2.Cells(u, 4).Value) =
UCase(frmBkCheckout.cboEmail.Value) Then
frmBkCheckout.txtName.Value = Sheet2.Cells(u, 3).Value
frmBkCheckout.txtUserName.Value = Sheet2.Cells(u, 1).Value
End If
Next u
'end get employee name
End Sub
Private Sub cmdClearForm_Click()
Call UserForm_Initialize
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub txtDateTaken_Change()
End Sub