Userform to enter entries and also search for and update entries in database

**royUK** · Jul 25th 2014

Re: Userform to enter entries and also search for and update entries in database

There's nothing wrong with using a Variable multiple times, but you must be sure that the order it is used does not affect later code.

Code

Private Sub userform_initialize()
    With Me
        .Caption = "Basecoat Log"    'userform caption
        .Height = frmHt
        .Width = frmWidth
        .ScrollBar1.Min = 2
        Set Ws = Worksheets("MasterColour")
        .ComboColour.List = Ws.Range("ColourList").Value
        .txtTimestamp.Value = Format(Now, "dd mmmm yyyy hh:mm")
        .txtBody.SetFocus
        'change sheet name and Range here
        Set Ws = Sheet1
        Set MyData = Ws.Range("a2").CurrentRegion    'database
        .ScrollBar1.Max = MyData.Rows.Count
    End With
End Sub




Private Sub cmbDelete_Click()
    Dim msgResponse As String    'confirm delete
    Application.ScreenUpdating = False
    'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
                         vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse    'action dependent on response
    Case vbYes
        'c has been selected by Find button
        c.EntireRow.Delete    'remove entry by deleting row
        Set MyData = Ws.Range("a2").CurrentRegion    'database
        'restore form settings
        With Me
            .cmbAmend.Enabled = False    'prevent accidental use
            .cmbDelete.Enabled = False    'prevent accidental use
            .cmbAdd.Enabled = True    'restore use
            .ScrollBar1.Max = MyData.Rows.Count
            'clear form
            ClearControls
        End With




    Case vbNo
        Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Display More

excelRay · Jul 28th 2014

Re: Userform to enter entries and also search for and update entries in database

royUK, I appreciate the help and advice, but when it comes to deleting an entry which is a multiple entry an error comes up, Run-time error '91': object var.. not set. the line

Code

c.EntireRow.Delete

excelRay · Aug 8th 2014

Re: Userform to enter entries and also search for and update entries in database

Hi,

Everytime i try to delete an entry i get an RUn-time error '91':
object var or with block var not set

Code

Private Sub cmbDelete_Click()    Dim msgResponse As String 'confirm delete
    Application.ScreenUpdating = False
     'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
    vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse 'action dependent on response
    Case vbYes
         'c has been selected by Find button
        c.EntireRow.Delete 'remove entry by deleting row
        Set MyData = Ws.Range("a2").CurrentRegion 'database
         'restore form settings
        With Me
            .cmbAmend.Enabled = False 'prevent accidental use
            .cmbDelete.Enabled = False 'prevent accidental use
            .cmbAdd.Enabled = True 'restore use
            .ScrollBar1.Max = MyData.Rows.Count
             'clear form
            ClearControls
        End With
         
         
    Case vbNo
        Exit Sub 'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Display More

but on my other userforms with this code it works fine.

**royUK** · Aug 8th 2014

Re: Userform to enter entries and also search for and update entries in database

Attach the problem workbook

excelRay · Aug 8th 2014

Re: Userform to enter entries and also search for and update entries in database

The workbook

**royUK** · Aug 8th 2014

Re: Userform to enter entries and also search for and update entries in database

The example userform contains references to sheets that are missing. I can't get the code to work how you have set it up.

This might work

Code

Private Sub cmbDelete_Click()
    Dim msgResponse As String 'confirm delete
    Application.ScreenUpdating = False
     'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
    vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse 'action dependent on response
    Case vbYes
         'r has been selected by Find button
         Set c = MyData.Cells(r, 1)
        c.EntireRow.Delete 'remove entry by deleting row
        Set MyData = Ws.Range("a2").CurrentRegion 'database
         'restore form settings
        With Me
            .cmbAmend.Enabled = False 'prevent accidental use
            .cmbDelete.Enabled = False 'prevent accidental use
            .cmbAdd.Enabled = True 'restore use
            .ScrollBar1.Max = MyData.Rows.Count
             'clear form
            ClearControls
        End With
         
         
    Case vbNo
        Exit Sub 'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Display More

excelRay · Aug 8th 2014

Re: Userform to enter entries and also search for and update entries in database

Sorry, i copied the specific userform and relevant page to a new workbook because the other file was too large to upload, even after compressing it

excelRay · Aug 8th 2014

Re: Userform to enter entries and also search for and update entries in database

But that code did the job. Thank you royUk. This was very much appreciated

excelRay · Aug 29th 2014

Re: Userform to enter entries and also search for and update entries in database

Hi,

This userform runs perfectly, but im having problems with the date. I have looked up formatting date from american to uk, using CDate and other examples but I haven't managed to make it work.

Code

Dim ws As Worksheet
Dim MyData As Range
Dim c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
Const frmMax As Long = 500
Const frmHt As Long = 350
Const frmWidth As Long = 300
Dim oCtrl As MSForms.Control












Private Sub cmbAdd_Click()
     'next empty cell in column A
     
     
    Set c = MyData.Cells(MyData.Rows.Count, 1).Offset(1)
     
      If ComboColour.Text = Empty Then
        MsgBox "Please select a colour.", vbExclamation
        Me.ComboColour.SetFocus
        Exit Sub
    End If
        
      If Not IsDate(txtDate) Then
        MsgBox "Input must be a date in the format: 'dd/mm/yyyy'"
        'Cancel = True
        Exit Sub
    Else
        txtDate = Format(txtDate, "mm/dd/yyyy")
    End If
     
    Application.ScreenUpdating = False 'speed up, hide task
     'write userform entries to database
    With Me
        c.Value = .txtDate.Value
                    
        c.Offset(0, 1).Value = .ComboColour.Value
        c.Offset(0, 2).Value = .ComboTech.Value
        c.Offset(0, 3).Value = .txtBody.Value
              'clear the form
        ClearControls
         'resize database
        Set MyData = c.CurrentRegion
        Me.ScrollBar1.Max = MyData.Rows.Count
    End With
    Application.ScreenUpdating = True
    
      xxx = Split(txtDate.Value, "/")
'ActiveCell.Offset(0, 2) = DateSerial(xxx(2), xxx(1), xxx(0))




    
End Sub
 
 
Private Sub cmbDelete_Click()
    Dim msgResponse As String 'confirm delete
    Application.ScreenUpdating = False
     'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
    vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse 'action dependent on response
    Case vbYes
         'c has been selected by Find button
        c.EntireRow.Delete 'remove entry by deleting row
        Set MyData = ws.Range("a2").CurrentRegion 'database
         'restore form settings
        With Me
            .cmbAmend.Enabled = False 'prevent accidental use
            .cmbDelete.Enabled = False 'prevent accidental use
            .cmbAdd.Enabled = True 'restore use
            .ScrollBar1.Max = MyData.Rows.Count
             'clear form
            ClearControls
        End With
         
         
    Case vbNo
        Exit Sub 'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub
 
 
Private Sub cmbFind_Click()
    Dim strFind As String 'what to find
    Dim FirstAddress As String
    Dim f As Integer
     
     
     '    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.txtDate.Value 'what to look for
     
     
    With MyData
        .AutoFilter
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then 'found it
             
             
            With Me 'load entry to form
                .ComboColour.Value = c.Offset(0, 1).Value
                .ComboTech.Value = c.Offset(0, 2).Value
                .txtBody.Value = c.Offset(0, 3).Value
                .cmbAmend.Enabled = True 'allow amendment or
                .cmbDelete.Enabled = True 'allow record deletion
                .cmbAdd.Enabled = False 'don't want to duplicate record
                 
                r = c.Row
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1 'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
                     
                     
                Case vbOK
                    FindAll
                Case vbCancel
                     'do nothing
                End Select
                Me.Height = frmMax
                 
                 
            End If
        Else: MsgBox strFind & " not listed" 'search failed
        End If
    End With
     
     
End Sub
 
 
Private Sub cmbAmend_Click()
    Application.ScreenUpdating = False
    If r <= 0 Then Exit Sub
     
     
    Set c = ws.Cells(r, 1)
    c.Value = Me.txtDate.Value ' write amendments to database
    c.Offset(0, 1).Value = Me.ComboColour.Value
    c.Offset(0, 2).Value = Me.ComboTech.Value
    c.Offset(0, 3).Value = Me.txtBody.Value
         'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
       ' ClearControls
        .Height = frmHt
    End With
    If Sheet12.AutoFilterMode Then Sheet12.Range("A2").AutoFilter
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub
Sub FindAll()
    Dim wesTemp As Worksheet
    Dim strFind As String 'what to find
     
     
    strFind = Me.txtDate.Value
     
     
    If Not ws.AutoFilterMode Then MyData.AutoFilter
     
     
    MyData.AutoFilter Field:=1, Criteria1:=strFind
     
     
    Me.ListBox1.Clear
    For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
        With ListBox1
            .AddItem c.Value
            .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
            .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
            .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
            .List(.ListCount - 1, 5) = c.Offset(0, 5).Value
            .List(.ListCount - 1, 6) = c.Offset(0, 6).Value
            .List(.ListCount - 1, 7) = c.Offset(0, 7).Value
            .List(.ListCount - 1, 8) = c.Row
        End With
    Next c
     
     
End Sub








Private Sub cmdClear_click()
        Me.txtDate.Value = ""
        Me.ComboColour.Value = ""
        Me.ComboTech.Value = ""
        Me.txtBody.Value = ""
End Sub




Private Sub ListBox1_Click()
     
     
    With Me.ListBox1
         
         
        If .ListIndex = -1 Then 'not selected
            MsgBox " No selection made"
        ElseIf .ListIndex >= 1 Then 'User has selected
            r = Val(.List(.ListIndex, .ColumnCount - 1))
        End If
    End With
     
     
    With Me
        .txtDate.Value = .ListBox1.List(.ListBox1.ListIndex, 0)
        .ComboColour.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
        .ComboTech.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
        .txtBody.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
        .cmbAmend.Enabled = True 'allow amendment or
        .cmbDelete.Enabled = True 'allow record deletion
        .cmbAdd.Enabled = False 'don't want duplicate
    End With
     
     
End Sub
 
 
Private Sub ScrollBar1_Change()
    Dim Rw As Long
    Rw = Me.ScrollBar1.Value
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .txtDate.Value = MyData.Cells(Rw, 1).Value
        .ComboColour.Value = MyData.Cells(Rw, 2).Value
        .ComboTech.Value = MyData.Cells(Rw, 3).Value
        .txtBody.Value = MyData.Cells(Rw, 4).Value
    End With
     
     
End Sub
 




 Private Sub txtDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
 ddate = DateSerial(Year(Date), Month(Date), Day(Date))
    txtDate.Value = Format(txtDate.Value, "dd/mm/yyyy")
    ddate = txtDate.Value
End Sub




 Private Sub UserForm_Initialize()
    With Me
        .Caption = "Basecoat Log" 'userform caption
        .Height = frmHt
        .Width = frmWidth
        .ScrollBar1.Min = 2
        Set ws = Worksheets("MasterColour")
        .ComboColour.List = ws.Range("ColourList").Value
        Set ws = Worksheets("MasterMaterial")
        .ComboTech.List = ws.Range("Tech").Value
         'change sheet name and Range here
        Set ws = Sheet12
        Set MyData = ws.Range("a2").CurrentRegion 'database
        .ScrollBar1.Max = MyData.Rows.Count
    End With
End Sub
Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
            Case "TextBox": oCtrl.Value = Empty
            End Select
        Next oCtrl
    End With
End Sub

Display More

**royUK** · Aug 29th 2014

Re: Userform to enter entries and also search for and update entries in database

Try using CLng

Code

strFind = CLng(Me.txtDate.Value) 'what to look for

excelRay · Sep 1st 2014

Re: Userform to enter entries and also search for and update entries in database

Sorry, where would I Plce this

excelRay · Sep 1st 2014

Re: Userform to enter entries and also search for and update entries in database

Sorry i asked the question before looking myself

excelRay · Sep 1st 2014

Re: Userform to enter entries and also search for and update entries in database

Hi RoyUk

I am getting type mismatch errors when I use the find button, but even so for everything else the date is in American format.

**royUK** · Sep 1st 2014

Re: Userform to enter entries and also search for and update entries in database

Without knowing if the dates are entered correctly as dates I can't say.

excelRay · Sep 2nd 2014

Re: Userform to enter entries and also search for and update entries in database

The dates are entered by the user in the format 'dd/mm'yy' or 'dd/mm/yyyy' in a standard text box

excelRay · Sep 2nd 2014

Re: Userform to enter entries and also search for and update entries in database

The code to enter it into the database is the one provided above

**royUK** · Sep 2nd 2014

Re: Userform to enter entries and also search for and update entries in database

I still need to know how they appear on the street, they may be enterinfg as Text. Look at my examples of calendars on userforms, probably the combobox is the best one for you.

Alternative DatePickers

excelRay · Sep 3rd 2014

Re: Userform to enter entries and also search for and update entries in database

As in how they appear in the sheet? they appear in the 'short date' format in UK, so 'dd/mm/yyyy'.

I have attempted to apply the code you suggested as follows:

Code

Dim ws As Worksheet
Dim MyData As Range
Dim c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
Const frmMax As Long = 500
Const frmHt As Long = 350
Const frmWidth As Long = 300
Dim oCtrl As MSForms.Control
Dim i As Long
Dim L As Long












Private Sub cmbAdd_Click()
     'next empty cell in column A
     
     
    Set c = MyData.Cells(MyData.Rows.Count, 1).Offset(1)
     
      If Combocolour.Text = Empty Then
        MsgBox "Please select a colour.", vbExclamation
        Me.Combocolour.SetFocus
        Exit Sub
    End If
     
    Application.ScreenUpdating = False 'speed up, hide task
     'write userform entries to database
    With Me
        c.Value = Format(DateSerial(CLng(Me.cboYear.Value), Me.cboMonth.ListIndex + 1, Me.cboDay.Value), "Short date")
                    
        c.Offset(0, 1).Value = .Combocolour.Value
        c.Offset(0, 2).Value = .ComboTech.Value
        c.Offset(0, 3).Value = .txtbody.Value
              'clear the form
        ClearControls
         'resize database
        Set MyData = c.CurrentRegion
        Me.ScrollBar1.Max = MyData.Rows.Count
    End With








Application.ScreenUpdating = True
    
     ' xxx = Split(txtDate.Value, "/")
'C.Offset(0, 2) = DateSerial(xxx(2), xxx(1), xxx(0))




    
End Sub
 
 
Private Sub cmbDelete_Click()
    Dim msgResponse As String 'confirm delete
    Application.ScreenUpdating = False
     'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
    vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse 'action dependent on response
    Case vbYes
         'c has been selected by Find button
        c.EntireRow.Delete 'remove entry by deleting row
        Set MyData = ws.Range("a2").CurrentRegion 'database
         'restore form settings
        With Me
            .cmbAmend.Enabled = False 'prevent accidental use
            .cmbDelete.Enabled = False 'prevent accidental use
            .cmbAdd.Enabled = True 'restore use
            .ScrollBar1.Max = MyData.Rows.Count
             'clear form
            ClearControls
        End With
         
         
    Case vbNo
        Exit Sub 'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub
 
 
Private Sub cmbFind_Click()
    Dim strFind As String 'what to find
    Dim FirstAddress As String
    Dim f As Integer
     
     
     '    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Format(DateSerial(CLng(Me.cboYear.Value), Me.cboMonth.ListIndex + 1, Me.cboDay.Value), "Short date") 'what to look for
     
     
    With MyData
        .AutoFilter
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then 'found it
             
             
            With Me 'load entry to form
                .Combocolour.Value = c.Offset(0, 1).Value
                .ComboTech.Value = c.Offset(0, 2).Value
                .txtbody.Value = c.Offset(0, 3).Value
                .cmbAmend.Enabled = True 'allow amendment or
                .cmbDelete.Enabled = True 'allow record deletion
                .cmbAdd.Enabled = False 'don't want to duplicate record
                 
                r = c.Row
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1 'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
                     
                     
                Case vbOK
                    FindAll
                Case vbCancel
                     'do nothing
                End Select
                Me.Height = frmMax
                 
                 
            End If
        Else: MsgBox strFind & " not listed" 'search failed
        End If
    End With
     
     
End Sub
 
 
Private Sub cmbAmend_Click()
    Application.ScreenUpdating = False
    If r <= 0 Then Exit Sub
     
     
    Set c = ws.Cells(r, 1)
    c.Value = Format(DateSerial(CLng(Me.cboYear.Value), Me.cboMonth.ListIndex + 1, Me.cboDay.Value), "Short date") ' write amendments to database
    c.Offset(0, 1).Value = Me.Combocolour.Value
    c.Offset(0, 2).Value = Me.ComboTech.Value
    c.Offset(0, 3).Value = Me.txtbody.Value
         'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
       ' ClearControls
        .Height = frmHt
    End With
    If Sheet12.AutoFilterMode Then Sheet12.Range("A2").AutoFilter
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub
Sub FindAll()
    Dim wesTemp As Worksheet
    Dim strFind As String 'what to find
     
     
    strFind = Format(DateSerial(CLng(Me.cboYear.Value), Me.cboMonth.ListIndex + 1, Me.cboDay.Value), "Short date")
     
     
    If Not ws.AutoFilterMode Then MyData.AutoFilter
     
     
    MyData.AutoFilter Field:=1, Criteria1:=strFind
     
     
    Me.ListBox1.Clear
    For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
        With ListBox1
            .AddItem c.Value
            .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
            .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
            .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
            .List(.ListCount - 1, 5) = c.Offset(0, 5).Value
            .List(.ListCount - 1, 6) = c.Offset(0, 6).Value
            .List(.ListCount - 1, 7) = c.Offset(0, 7).Value
            .List(.ListCount - 1, 8) = c.Row
        End With
    Next c
     
     
End Sub








Private Sub cmdClear_click()
        'Me.txtDate.Value = ""
        Me.Combocolour.Value = ""
        Me.ComboTech.Value = ""
        Me.txtbody.Value = ""
End Sub




Private Sub ListBox1_Click()
     
     
    With Me.ListBox1
         
         
        If .ListIndex = -1 Then 'not selected
            MsgBox " No selection made"
        ElseIf .ListIndex >= 1 Then 'User has selected
            r = Val(.List(.ListIndex, .ColumnCount - 1))
        End If
    End With
     
     
    With Me
        Format(DateSerial(CLng(Me.cboYear.Value), Me.cboMonth.ListIndex + 1, Me.cboDay.Value), "Short date") = .ListBox1.List(.ListBox1.ListIndex, 0)
        .Combocolour.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
        .ComboTech.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
        .txtbody.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
        .cmbAmend.Enabled = True 'allow amendment or
        .cmbDelete.Enabled = True 'allow record deletion
        .cmbAdd.Enabled = False 'don't want duplicate
    End With
     
     
End Sub
 
 
Private Sub ScrollBar1_Change()
    Dim Rw As Long
    Rw = Me.ScrollBar1.Value
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
       .cboYear.Value , .cboMonth.ListIndex + 1, .cboDay.Value = MyData.Cells(Rw, 1).Value
        .Combocolour.Value = MyData.Cells(Rw, 2).Value
        .ComboTech.Value = MyData.Cells(Rw, 3).Value
        .txtbody.Value = MyData.Cells(Rw, 4).Value
    End With
     
     
End Sub
 




 Private Sub txtDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
 ddate = DateSerial(year(Date), Month(Date), Day(Date))
    txtdate.Value = Format(txtdate.Value, "dd/mm/yyyy")
    ddate = txtdate.Value
End Sub




 Private Sub UserForm_Initialize()
    With Me
        .Caption = "Basecoat Log" 'userform caption
        .Height = frmHt
        .Width = frmWidth
        .ScrollBar1.Min = 2
        Set ws = Worksheets("MasterColour")
        .Combocolour.List = ws.Range("ColourList").Value
        Set ws = Worksheets("MasterMaterial")
        .ComboTech.List = ws.Range("Tech").Value
         'change sheet name and Range here
        Set ws = Sheet12
        Set MyData = ws.Range("a2").CurrentRegion 'database
        .ScrollBar1.Max = MyData.Rows.Count
    End With
    With Me
.lblDate.Caption = "Select date:"
  With .cboYear
            .Clear
            'change the number to adjust years shown
            For i = -1 To 1
                .AddItem (Format(Date, "YYYY")) + i
            Next
            .ListIndex = 1
        End With
        With .cboMonth
            .Clear
            .List = Application.GetCustomListContents(4)
            .ListIndex = Month(Date) - 1
            L = .ListIndex
        End With
End With




loadDays
End Sub
Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
            Case "TextBox": oCtrl.Value = Empty
            End Select
        Next oCtrl
    End With
End Sub








Sub loadDays()
    i = Me.cboMonth.ListIndex + 1




    With Me.cboDay
        .Clear
        Select Case i
            Case 4, 6, 9, 11
                L = 30
            Case 2
                If LeapYear(Me.cboYear.Value) Then
                    L = 29
                Else: L = 28
                End If
            Case Else
                L = 31
        End Select
        For i = 1 To L
            .AddItem Format(i, "00")
        Next i
                    .ListIndex = Day(Date) - 1
    End With
End Sub

Display More

When it comes to adding it seems like I adapted the code correctly but when it comes to the other features; scroll bar, find i haven't managed to figure out the correct way to adapt it.

But even so in my userform I inputted the following date '03/09/2014' but it saved in the sheet as 09/03/'2014'

excelRay · Sep 3rd 2014

Re: Userform to enter entries and also search for and update entries in database

Hi

On further attempts at adapting the code you suggested for the scrollbar I managed to change it to:

Code

Private Sub ScrollBar1_Change()
    Dim Rw As Long
    Rw = Me.ScrollBar1.Value
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .cboYear.Value = year(MyData.Cells(Rw, 1).Value)
        .cboMonth.Value = MonthName(Month((MyData.Cells(Rw, 1).Value)))
        .cboDay.Value = Day(MyData.Cells(Rw, 1).Value)
        .ComboColour.Value = MyData.Cells(Rw, 2).Value
        .ComboTech.Value = MyData.Cells(Rw, 3).Value
        .txtBody.Value = MyData.Cells(Rw, 4).Value
    End With
     
     
End Sub

Display More

This seems to work, but my other command buttons dont function still having difficulty with myListbox, and Find features. My attempt is below:

Code

Private Sub cmbFind_Click()
    Dim strFind As String 'what to find
    Dim FirstAddress As String
    Dim f As Integer
     
     
     '    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.cboYear.Value
    strFind = Me.cboMonth.Value
    strFind = Me.cboDay.Value 'what to look for
     
     
    With MyData
        .AutoFilter
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then 'found it
             
             
            With Me 'load entry to form
                .ComboColour.Value = c.Offset(0, 1).Value
                .ComboTech.Value = c.Offset(0, 2).Value
                .txtBody.Value = c.Offset(0, 3).Value
                .cmbAmend.Enabled = True 'allow amendment or
                .cmbDelete.Enabled = True 'allow record deletion
                .cmbAdd.Enabled = False 'don't want to duplicate record
                 
                r = c.Row
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1 'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
                     
                     
                Case vbOK
                    FindAll
                Case vbCancel
                     'do nothing
                End Select
                Me.Height = frmMax
                 
                 
            End If
        Else: MsgBox strFind & " not listed" 'search failed
        End If
    End With
     
     
End Sub


Sub FindAll()
    Dim wesTemp As Worksheet
    Dim strFind As String 'what to find
     
     
    strFind = Me.cboYear.Value
    strFind = Me.cboMonth.Value
    strFind = Me.cboDay.Value 'what to look for
     
    If Not ws.AutoFilterMode Then MyData.AutoFilter
     
     
    MyData.AutoFilter Field:=1, Criteria1:=strFind
     
     
    Me.ListBox1.Clear
    For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
        With ListBox1
            .AddItem c.Value
            .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
            .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
            .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
            .List(.ListCount - 1, 5) = c.Offset(0, 5).Value
            .List(.ListCount - 1, 6) = c.Offset(0, 6).Value
            .List(.ListCount - 1, 7) = c.Offset(0, 7).Value
            .List(.ListCount - 1, 8) = c.Row
        End With
    Next c
     
     
End Sub

Display More

Userform to enter entries and also search for and update entries in database

Participate now!

Share