Replace table with Userform

Hi,

How can the table be replaced with a data entry form please?

Thanks

This is a little strange, because your Table has blank rows in it, which means you'll have to find the first empty row. This can be tricky, although your Table is very, very simple. If you try this on more complicated Table's it can be trickier.

Take a look at the attached. A small form with two controls.
Attachment 26288

Thank you very much. I am sorry for having blank rows. I thought that if the sheet is protected the table won't expand. Also can there be separate fields for time and date instead of combined?

Sure. You should be able to work that out with what I've provided. Look at the control names to name it appropriately. You can see how I separated the date from the time. When dealing with dates/times, I generally just force it into a variable of the Date type and let Excel sort it out whether it recognizes it or not. Manual entry is generally not advised for dates/times. The other option is to create a drop down, but that gets more manual. This is the simplest solution.

Also, when the Table is full, there is a piece of code which adds a new row. If the sheet will be protected that will fail, so you may want to take that out.

It would also be nice to edit appointments or search in some way. I was looking on youtube and saw some with scrolls to jump to new records (appointments in my case), save, delete, etc. How did you come up with the coding? I want to learn how to do this also please.

Hi again,

I attempted to separate the time and date but not sure how to assign the boxes.

If you want to edit appointments via userform, it will take a bit more work. Userforms are really nice and handy in many situations. Their biggest downside lies in the fact that you have to program 100% of them. This is a downfall of VBA, honestly. Most modern tools are much, much more forgiving.

As far as your solution goes, we can leverage the form already created. What I would do is create another form with a listbox pointing to your Table. Then, if a user double-clicks on a list item, have it launch that first form and load it with that rows details. If the user changes it (i.e. clicking "OK") then update the Table accordingly, otherwise just unload the second form. This is actually a very good exercise if you've never worked with userforms before. I'll code that real quick. In the meantime, study the code and try to step through it so you can see how it works. (Hint: F8 steps through the code. Setting breakpionts (F9) helps as well.)

Thank you I will study and try to figure out the code.:yes

Take a look at the attached. This is a great example of using more than one userform in conjunction with each other. We're using the first form (fAppointment - note singular name) to load an appointment item from fAppointments (note the plural name).

I also took the time to add two properties to fAppointment. This has several advantages. First and foremost, you can load these properties up when calling the form, either by launch or by another form. You can set defaults if you don't want to use the system's (i.e. a Long variable will default with a 0 value, a String will be vbNullString or "", a Boolean will be False, etc.).

While this is starting to get into intermediate VBA, it still serves as a great example for how to use them. If you want to be good with VBA, these are excellent fundamentals to learn early on. Don't worry too much about how to structure custom properties or how to code them, there are tools to help you write them so you don't have to have the exact nomenclature memorized. The thing you need to know is 1) they all have a default based on the [variable] type, 2) you can have a read-only property, 3) you can have a read-write property, 4) you can perform any action within those properties, i.e. "do this when someone gets this property value".

File: Attachment 26292

For transparency and ease of consumption, I'll post the code below.

fAppointment properties:

Code:

---

' Variables to hold [value] for writing property
Private pNewAppointment As Boolean
Private pAppointmentIndex As Long


Public Property Get NewAppointment() As Boolean
' Read property

    NewAppointment = pNewAppointment

End Property


Public Property Let NewAppointment( _
      ByVal Value As Boolean _
      )
' Write property

    pNewAppointment = Value

End Property


Public Property Get AppointmentIndex() As Long
' Read property

    AppointmentIndex = pAppointmentIndex

End Property


Public Property Let AppointmentIndex( _
      ByVal Value As Long _
      )
' Write property

    pAppointmentIndex = Value

End Property

---

fAppointment button commands:

Code:

---

Private Sub CancelButton_Click()

    Unload Me

End Sub

Private Sub OkButton_Click()

    Dim Table As ListObject
    Dim DateTime As Date
    Dim DatePart As Date
    Dim TimePart As Date
    Dim Index As Long

    On Error Resume Next
    DateTime = CDate(Me.tDateTime.Value)
    DatePart = Int(DateTime)
    TimePart = DateTime - DatePart
    On Error GoTo 0

    If DateTime = 0 Then
        MsgBox "Please enter a date and time.", vbExclamation + vbOKOnly, "Date/Time"
        Exit Sub
    End If

    If Me.tAppointment.Value = vbNullString Then
        MsgBox "Please enter an appointment text.", vbExclamation + vbOKOnly, "Appointment"
        Exit Sub
    End If

    Set Table = ThisWorkbook.Worksheets("Calendar").ListObjects("Table2")

    If Me.NewAppointment Then
        If Table.DataBodyRange Is Nothing Then
            Table.ListRows.Add
            Me.AppointmentIndex = 1
        Else
            For Index = 1 To Table.ListRows.Count
                If WorksheetFunction.CountA(Table.DataBodyRange(Index, 1).Resize(1, 3)) = 0 Then
                    Me.AppointmentIndex = Index
                    Exit For
                End If
            Next Index
        End If
        If Index > Table.ListRows.Count Then
            Table.ListRows.Add
        End If
    Else
        Index = Me.AppointmentIndex
    End If

    If Me.AppointmentIndex > 0 Then
        Table.DataBodyRange(Me.AppointmentIndex, 1).Value = Format(TimePart, "h:mm AM/PM")
        Table.DataBodyRange(Me.AppointmentIndex, 2).Value = Me.tAppointment.Value
        Table.DataBodyRange(Me.AppointmentIndex, 3).Value = Format(DatePart, "mm/dd/yyyy")
        Unload Me
    Else
        MsgBox "Something went wrong.", vbExclamation + vbOKOnly, "Whoops!"
    End If

End Sub

---

fAppointments buttom commands:

Code:

---

Private Sub lAppointments_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim Appointment As New fAppointment
    Dim DateTime As Date
    Dim Index As Long
    Dim SelectedIndex As Long
   
    For Index = 0 To Me.lAppointments.ListCount - 1
        If Me.lAppointments.Selected(Index) Then
            SelectedIndex = Index
            Exit For
        End If
    Next Index
    If SelectedIndex = 0 Then Exit Sub
   
    On Error Resume Next
    DateTime = Me.lAppointments.List(SelectedIndex, 2) + Me.lAppointments.List(SelectedIndex, 0)
    On Error GoTo 0
   
    Load Appointment
    Appointment.tDateTime.Value = Format(DateTime, "m/d/yyyy h:mm AM/PM")
    Appointment.tAppointment.Value = Me.lAppointments.List(SelectedIndex, 1)
    Appointment.NewAppointment = False
    Appointment.AppointmentIndex = SelectedIndex + 1
    Appointment.Show
    Me.Repaint

End Sub


Private Sub CloseButton_Click()
   
    Unload Me
   
End Sub

---

Buttom calls/form loads:

Code:

---

Sub ShowAppointments()
   
    Dim Appointments As New fAppointments
    Load Appointments
    Appointments.Show
   
End Sub


Sub ShowAddAppointment()

    Dim Appointment As New fAppointment
    Load Appointment
    Appointment.NewAppointment = True
    Appointment.Show
   
End Sub

---

You are amazing at this wow! Can I ask one small favor please? I would prefer the time and date be separate when adding new appointments. I tried to do that but am messing up the coding badly.

Thank you

Sure, no problem. It's an easy fix.

File: Attachment 26294

Thank you very much for you great help. I will do my best to understand how this all functions.

Cheers!

You're very welcome. VBA is a very powerful tool. Post back with any questions on it.

Zack,

I ran into issues when trying to call my Protect code. The table that has the appointments where the calendar gets data changes the cell references so the new appointments don't show up. I was wondering if you have the chance to take a look to see if this can be corrected.

Thank you very much

If you're to the point where you're adding rows to a Table, that must be done on an unprotected worksheet. This is a known bug (Microsoft doesn't consider it a bug, but I do). You have to:

• Unprotect sheet
• Run your code (add row/data)
• Re-protect sheet

Yes I was trying to call the Unprotect and then call the Protect codes in your codes but wasn't successful.

Why call the code? just use:

Code:

---

    Sheet1.Unprotect
    'do stuff...
    Sheet1.Protect

---

with whichever sheet you want to update.

Ok, I see what you're doing. Don't call the Unprotect in the standard module routines, those which call the userforms. Instead, do it when you touch the grid.

I made three adjustments. Two were for the protection bit, one was a bug in my earlier code - a scenario where a newly added row wouldn't get a proper index/row value and you'd get an error. You would see this scenario if the Table didn't have any blank rows. I have fixed in the below code.


1. In 'Protection' module, add these routines. They give you a targeted approach, rather than blanketing every sheet with protect/unprotect calls.

Code:

---

Public Function ProtectSheet( _
    ByVal Sheet As Worksheet, _
    Optional ByVal Password As String _
    ) As Boolean
   
    If Sheet.ProtectContents Then
        ProtectSheet = True
        Exit Function
    End If
   
    On Error Resume Next
    Sheet.Protect Password
    On Error GoTo 0
   
    If Sheet.ProtectContents Then
        ProtectSheet = True
    End If
   
End Function


Public Function UnprotectSheet( _
    ByVal Sheet As Worksheet, _
    Optional ByVal Password As String _
    ) As Boolean
   
    If Sheet.ProtectContents = False Then
        UnprotectSheet = True
        Exit Function
    End If
   
    On Error Resume Next
    Sheet.UnProtect Password
    On Error GoTo 0
   
    If Sheet.ProtectContents = False Then
        UnprotectSheet = True
    End If
   
End Function

---

2. In 'mAppointment' remove your protect/unprotect calls.

3. In 'fAppointment' remove your protect/unprotect calls. Adjust your 'OkButton' routine to the below code.

Code:

---

Private Sub OkButton_Click()

    Dim Table As ListObject
    Dim DatePart As Date
    Dim TimePart As Date
    Dim Index As Long

    On Error Resume Next
    DatePart = CDate(Me.tDate.Value)
    TimePart = CDate(Me.tTime.Value)
    On Error GoTo 0

    If DatePart = 0 Or TimePart = 0 Then
        MsgBox "Please enter a date and time.", vbExclamation + vbOKOnly, "Date/Time"
        Exit Sub
    End If

    If Me.tAppointment.Value = vbNullString Then
        MsgBox "Please enter an appointment text.", vbExclamation + vbOKOnly, "Appointment"
        Exit Sub
    End If

    Set Table = ThisWorkbook.Worksheets("Calendar").ListObjects("Table2")

    UnprotectSheet Table.Parent
    If Me.NewAppointment Then
        If Table.DataBodyRange Is Nothing Then
            Table.ListRows.Add
            Me.AppointmentIndex = 1
        Else
            For Index = 1 To Table.ListRows.Count
                If WorksheetFunction.CountA(Table.DataBodyRange(Index, 1).Resize(1, 3)) = 0 Then
                    Me.AppointmentIndex = Index
                    Exit For
                End If
            Next Index
        End If
        If Index > Table.ListRows.Count Then
            Table.ListRows.Add
            Me.AppointmentIndex = Index
        End If
    Else
        Index = Me.AppointmentIndex
    End If

    If Me.AppointmentIndex > 0 Then
        Table.DataBodyRange(Me.AppointmentIndex, 1).Value = Format(TimePart, "h:mm AM/PM")
        Table.DataBodyRange(Me.AppointmentIndex, 2).Value = Me.tAppointment.Value
        Table.DataBodyRange(Me.AppointmentIndex, 3).Value = Format(DatePart, "mm/dd/yyyy")
        Unload Me
    Else
        MsgBox "Something went wrong.", vbExclamation + vbOKOnly, "Whoops!"
    End If
   
    ProtectSheet Table.Parent
   
End Sub

---

@paulked: It's a good idea to compartmentalize your code, such as separate routines for protecting and unprotecting, as it keeps your code modular, reusable, and easier to maintain and debug. If this were the only code ever written, then sure, just call it in the routine.

Thanks Zack I did all the steps and tried to add a new appointment. Excel shuts down when clicking the Ok button.