user form dates

[theYaniac]

I would like for a date being taken from a user form to have one year added to the date. For example if you enter 1-9-18 in the text box on the form I would like the date that goes into the data sheet to be 1-9-19. Any help would be greatly appreciated

 

[dmt32]

A quick glance cannot see any reason why you have error if these are the only codes in your userform
What I do note though is that you have not copied the update code as I published it.

Remove ALL existing code & apply unchanged the following:

Function GetDate(ByVal Text As String) As Variant
    If IsDate(Text) Then GetDate = DateValue(DateAdd("yyyy", 1, Text)) Else GetDate = Text
End Function


Private Sub CommandButton1_Click()
    Dim TargetRow As Long, LastRow
    Dim FullName As String 'full name
    Dim wsData As Worksheet
    
    Set wsData = ThisWorkbook.Worksheets("Data")
    
    FullName = Txt_FirstName & " " & Txt_LastName
    
    LastRow = wsData.Cells(wsData.Rows.Count, "E").End(xlUp).Row
    
    With ThisWorkbook.Worksheets("Engine")
        .Visible = True
        
        With .Range("B3")
            If .Offset(, 1).Value = "NEW" Then
                If Application.WorksheetFunction.CountIf(wsData.Range("E8:E" & LastRow), FullName) > 0 Then
                    MsgBox FullName & Chr(10) & "Name already exists", 64, "Check"
                    Exit Sub
                End If
                TargetRow = .Value + 1
            Else
                TargetRow = .Value
            End If
        End With
    End With
    
    
    Application.ScreenUpdating = False
'Begin Data Input to Database
'Begin Data Input to Database
    With wsData.Range("Data_Start")
        .Offset(TargetRow, 0).Value = TargetRow
        .Offset(TargetRow, 1).Value = Txt_FirstName 'first name
        .Offset(TargetRow, 2).Value = Txt_LastName 'last name
        .Offset(TargetRow, 3).Value = Txt_FirstName & " " & Txt_LastName 'full name
        .Offset(TargetRow, 4).Value = Txt_Phone 'contact number
        .Offset(TargetRow, 5).Value = Combo_Craft 'craft
        .Offset(TargetRow, 6).Value = Combo_Classification 'classification
        .Offset(TargetRow, 7).Value = Combo_Group 'group affiliation
        .Offset(TargetRow, 8).Value = Txt_BadgeNumber 'BP badge number
        .Offset(TargetRow, 9).Value = Txt_AKIDNumber 'L&I ID number
        
'increment dates + 1 year
        .Offset(TargetRow, 10).Value = GetDate(Txt_DrivingCert) 'BP driving cert
        .Offset(TargetRow, 11).Value = GetDate(Txt_ATFLCert) 'All terrain forklift cert
        .Offset(TargetRow, 12).Value = GetDate(Txt_MLCert) 'manlift cert
        .Offset(TargetRow, 13).Value = GetDate(Txt_RespCert) 'respirator cert
        .Offset(TargetRow, 14).Value = GetDate(Txt_CSECert) 'confined space entry cert
        .Offset(TargetRow, 15).Value = GetDate(Txt_CSACert) 'confined space attendant cert
        .Offset(TargetRow, 16).Value = GetDate(Txt_LOTOCert) 'lockout tagout cert
        .Offset(TargetRow, 17).Value = GetDate(Txt_SkidSteerCert) 'bobcat cert
        .Offset(TargetRow, 18).Value = GetDate(Txt_FELCert) 'front end loader cert
    End With
    
    Sheets("Engine").Visible = xlVeryHidden
    Unload Me 'close the user form
    MsgBox FullName & Chr(10) & " was added to database", 64, "Complete"
    Application.ScreenUpdating = True
End Sub

Dave

 

[theYaniac]

Dave, I appreciate you helping with this. The date portion is working perfectly. However, the positioning is now off. I am currently trying to get the positioning back where I need it. When I edit an employee now, it sends the edited data to the bottom row in the table versus updating the employee records in the row they are stored in. The "Engine" sheet has 3 cells that are referenced in the code I originally had in there. The updated version has some changes that I am trying to figure out. I am still very new to the VBA process, so I apologize if I am being a pain in the butt.
(updated code)
Private Sub CommandButton1_Click()
Dim TargetRow As Long, LastRow
Dim FullName As String 'full name
Dim wsData As Worksheet

Set wsData = ThisWorkbook.Worksheets("Data")

FullName = Txt_FirstName & " " & Txt_LastName

LastRow = wsData.Cells(wsData.Rows.Count, "E").End(xlUp).Row

With ThisWorkbook.Worksheets("Engine")
.Visible = True

With .Range("B3")
If .Offset(, 1).Value = "NEW" Then
If Application.WorksheetFunction.CountIf(wsData.Range("E8:E" & LastRow), FullName) > 0 Then
MsgBox FullName & Chr(10) & "Name already exists", 64, "Check"
Exit Sub
End If
TargetRow = .Value + 1
Else
TargetRow = .Value
End If
End With
End With

(Original code)
Private Sub CommandButton1_Click()


Dim TargetRow As Integer
Dim FullName As String 'full name


Application.ScreenUpdating = False
Sheets("Engine").Visible = True
If Sheets("Engine").Range("B4").Value = "NEW" Then
TargetRow = Sheets("Engine").Range("B3").Value + 1
Else
TargetRow = Sheets("Engine").Range("B5").Value
End If


FullName = Txt_FirstName & " " & Txt_LastName


If Sheets("Engine").Range("B4").Value = "NEW" Then
'begin validation check
If Application.WorksheetFunction.CountIf(Sheets("Data").Range("E8:E10008"), FullName) > 0 Then
MsgBox "Name already exists", 0, "Check"
Exit Sub

End If
End If

 

[dmt32]

sorry, overlooked part of your code

Dim TargetRow As Long, LastRow
    Dim FullName As String 'full name
    Dim wsData As Worksheet
    
    Set wsData = ThisWorkbook.Worksheets("Data")
    
    FullName = Txt_FirstName & " " & Txt_LastName
    
    LastRow = wsData.Cells(wsData.Rows.Count, "E").End(xlUp).Row
    
    With ThisWorkbook.Worksheets("Engine")
        .Visible = True
        
        With .Range("B3")
            If .Offset(, 1).Value = "NEW" Then
                If Application.WorksheetFunction.CountIf(wsData.Range("E8:E" & LastRow), FullName) > 0 Then
                    MsgBox FullName & Chr(10) & "Name already exists", 64, "Check"
                    Exit Sub
                End If
                TargetRow = .Value + 1
            Else
                TargetRow = .Offset(, 2).Value
            End If
        End With
    End With

Update code as per line shown in RED which I think is reason you have issue

Dave

 

[theYaniac]

It works perfectly now. Thank you for the assistance.