How do you get a VBA Userform to insert row according to date?

[freddie mitchell]

Hello everyone,

I have been working on a calendar of events worksheet that requires a VBA userform. The form is up and running, sort of, but I haven't managed to crack what code I need to create a new row according to the date the user has entered in the form.

For example, if someone enters 01.11.2020 in the userform's date textbox, I'd like the worksheet to create a new row after October 31st and before November 2nd.

The real kicker is that not every calendar day is represented in the worksheet, just those days that events are happening on (typically 15 to 20 entries per month), so a precise calendar reference brings up an error as it is unlikely that a new event will fall neatly one day after and one day before existing entries.

Thank you to the community for your help with this, especially John W who gave a fantastic piece of code at the start of this difficult but fascinating project!

 

[dmt32]

Hi,
just a quick thought to your requirement, could you not adjust your code to post record to the worksheet & then sort the range by date?

If need assistance, always helpful if you share code you are using with forum, plenty here to offer suggestions.

Dave

 

[Norie]

Which column are the existing dates in?

 

[freddie mitchell]

Hi Dave and Norie,

Apologies Dave, I fear that my coding knowledge is not good enough to answer your question correctly.

Norie, the dates are recorded in column A. I am currently using a macro code to open the worksheet at the nearest date to today. The macro uses the dates in Column A, so I hope Excel can also insert a new development using the same dates in column A for reference.


Here is the code I currently have. It just adds a new row, not contingent on a date. (I hope I've put the code tags on correctly?)

Private Sub OKButton_Click()

Dim emptyRow As Long

'Make Sheet1 active
Sheet1.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
Cells(emptyRow, 4).Value = NameTextBox.Value
Cells(emptyRow, 1).Value = PhoneTextBox.Value
Cells(emptyRow, 2).Value = PhoneTextBox2.Value
Cells(emptyRow, 13).Value = ClientComboBox.Value
Cells(emptyRow, 5).Value = CountryComboBox.Value

If DateCheckBox1.Value = True Then Cells(emptyRow, 6).Value = Cells(emptyRow, 6).Value & "X"

If DateCheckBox2.Value = True Then Cells(emptyRow, 7).Value = Cells(emptyRow, 7).Value & "X"
If DateCheckBox3.Value = True Then Cells(emptyRow, 8).Value = Cells(emptyRow, 8).Value & "X"

 

[John_w]

Try this. I've used DateTextBox as the name of your userform date text box, so change the code if yours is different.

Public Sub Insert_Row()

    Dim userformDate As Date
    Dim r As Variant
    
    userformDate = CDate(Replace(DateTextBox, ".", "-"))
    
    With Worksheets("Sheet1")
        r = Application.Match(CLng(userformDate), .Columns(1), 1)
        If IsError(r) Then
            .Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Cells(2, 1).Value = userformDate
        ElseIf .Cells(r, 1).Value < userformDate Then
            .Rows(r + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Cells(r + 1, 1).Value = userformDate
        End If
    End With
    
End Sub

 

[freddie mitchell]

Hi John,

Am I putting this in the userform or workbook section of the VBA code?

Freddie

 

[freddie mitchell]

*I'm certain that your code will work, but I'm still only a rookie and so I'm not sure how / where to put the date text box code to get it to work correctly? I've added it to the userform, but so far it has not changed what happens when I click the ok button on the userform.

Thank you again to everyone for your help, much appreciated

Freddie

 

[John_w]

Put it in the userform module and call it from the userform's command button click event handler.

 

[freddie mitchell]

Hi John,

Super duper, your code works 100%, thank you so much. But I have not been able to combine the existing code, which tells the worksheet to put the various Userform values into specific cells, into yours.

So the worksheet is now adding a beautiful row according to the date column, but the values added in the Userform don't appear in the new row.

Could you take a look and offer some guidance on how to resolve this?

This is what I have so far, which you'll see is just the original code tacked on to your piece:

Private Sub OKButton_Click()

'adding in a date specific row
Call Insert_Row

End Sub

Public Sub Insert_Row()

    Dim userformDate As Date
    Dim r As Variant
    
    userformDate = CDate(Replace(StartDate, ".", "-"))
    
    With Worksheets("CEE rolling calendar of events")
        r = Application.Match(CLng(userformDate), .Columns(1), 1)
        If IsError(r) Then
            .Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Cells(2, 1).Value = userformDate
        ElseIf .Cells(r, 1).Value < userformDate Then
            .Rows(r + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Cells(r + 1, 1).Value = userformDate
        End If
        
        If StartDate.Value = "DD/MM/YY or month" Then
StartDate.Value = ""
End If


If EndDate.Value = "DD/MM/YY or month" Then
EndDate.Value = ""
End If

Dim emptyRow As Long

'Make Sheet1 active
Sheet1.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
Cells(emptyRow, 4).Value = NameTextBox.Value
Cells(emptyRow, 1).Value = StartDate.Value
Cells(emptyRow, 2).Value = EndDate.Value
Cells(emptyRow, 13).Value = ClientComboBox.Value
Cells(emptyRow, 5).Value = CountryComboBox.Value

If OfficialVisitBox.Value = True Then Cells(emptyRow, 6).Value = Cells(emptyRow, 6).Value & "X"

If ElectionBox.Value = True Then Cells(emptyRow, 7).Value = Cells(emptyRow, 7).Value & "X"
If IFLBox.Value = True Then Cells(emptyRow, 8).Value = Cells(emptyRow, 8).Value & "X"


    End With
    
End Sub

 

[John_w]

Try this - the routine puts 5 of the userform fields in the new row and I'll leave you to do the rest.

Public Sub Insert_Row()

    Dim r As Variant
    Dim userformDate As Date
    
    userformDate = CDate(Replace(StartDate.Value, ".", "-"))
   
    With Worksheets("CEE rolling calendar of events")
    
        r = Application.Match(CLng(userformDate), .Columns(1), 1)
        If IsError(r) Then
            r = 2
        ElseIf .Cells(r, 1).Value < userformDate Then
            r = r + 1
        End If
    
        .Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   
        'Transfer information from userform to new row
        
        .Cells(r, 4).Value = NameTextBox.Value
        .Cells(r, 1).Value = userformDate
        .Cells(r, 2).Value = CDate(Replace(EndDate.Value, ".", "-"))
        .Cells(r, 13).Value = ClientComboBox.Value
        .Cells(r, 5).Value = CountryComboBox.Value
    
    End With

End Sub