自动将条形添加到日期单元格

Question

I need a VBA code that inserts bars automatically in cells with date format.

I mean, you type 010101 in a cell and, after moving to the next, the cell converts 010101 to 01/01/2001 automatically.

I already have a code that insert bars, but it only works in cells with text format.

The code I have is as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
 Set MyIntersect = Intersect(Target, Cells)
 If (Not (MyIntersect Is Nothing)) And (Not IsEmpty(MyIntersect)) Then
  Dim UserData As String: UserData = MyIntersect.Value
  If Right(UserData, 2) <= Mid(CStr(Year(Date)), 3, 2) Then
   UserData = Left(UserData, 4) & "20" & Right(UserData, 2)
  Else
   UserData = Left(UserData, 4) & "19" & Right(UserData, 2)
  End If
  UserData = Left(UserData, 2) & "/" & Mid(UserData, 3, 2) & "/" & _ 
  Right(UserData, 4)
  Application.EnableEvents = False
  MyIntersect.Value = UserData
  Application.EnableEvents = True
 End If
End Sub

Answer 1

I found the answer. The trick was to convert the intersection.value first to long and then to string, and add a zero to the string if its lenght is equal to five. The user must insert date as DDMMYY only, otherwise the code will not work, except if improved later.

The code is as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
Set MyIntersect = Intersect(Target, Cells)
 If (Not (MyIntersect Is Nothing)) And (Not IsEmpty(MyIntersect)) Then
  Dim UserData As String: UserData = CStr(CLng(MyIntersect.Value))
  If Len(UserData) = 5 Then UserData = "0" & UserData
  If Right(UserData, 2) <= Mid(CStr(Year(Date)), 3, 2) Then
   UserData = Left(UserData, 4) & "20" & Right(UserData, 2)
  Else
   UserData = Left(UserData, 4) & "19" & Right(UserData, 2)
  End If
  UserData = Left(UserData, 2) & "/" & Mid(UserData, 3, 2) & "/" & _
  Right(UserData, 4)
  Application.EnableEvents = False
  MyIntersect.Value = UserData
  Application.EnableEvents = True
 End If
End Sub