Changing column of date values from YYYYMMDD to MM/DD/YYYY in VBA

Question

I have a range of date values for one sheet that show date values as 20160812. Im looking for the values to show as 08/12/2016 instead.

This is the code i have currently:

Private Sub Update_Click()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim path As String, fileName As String
Dim lastRowUniversal As Long, lastRowOutput As Long, rowCntr As Long, lastColumn As Long
Dim inputWS1 As Worksheet, inputWS2 As Worksheet, inputWS3 As Worksheet, outputWS As Worksheet



Const dtFORM As String = "=IF(ISNUMBER(J4:J<r>),DATE(YEAR(J4:J<r>)-1," & "MONTH(J4:J<r>),DAY(J4:J<r>)),J4:J<r>)"



'set your sheets here
Set inputWS1 = ThisWorkbook.Sheets("Universal")
Set inputWS2 = ThisWorkbook.Sheets("Geovera")
Set inputWS3 = ThisWorkbook.Sheets("Citizens")
Set outputWS = ThisWorkbook.Sheets("Carriers")


    'get last rows from both sheets
lastRowUniversal = inputWS1.Cells(Rows.Count, "A").End(xlUp).Row
LastRowCitizens = inputWS3.Cells(Rows.Count, "A").End(xlUp).Row
lastRowGeovera = inputWS2.Cells(Rows.Count, "A").End(xlUp).Row
LastRowPolicy = outputWS.Cells(Rows.Count, "B").End(xlUp).Row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).Row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column


    'get last rows from both sheets
lastRowUniversal = inputWS1.Cells(Rows.Count, "A").End(xlUp).Row
LastRowCitizens = inputWS3.Cells(Rows.Count, "A").End(xlUp).Row
lastRowGeovera = inputWS2.Cells(Rows.Count, "A").End(xlUp).Row
LastRowPolicy = outputWS.Cells(Rows.Count, "B").End(xlUp).Row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).Row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column

rowCntr = 1

'get last rows from both sheets
lastRowUniversal = inputWS1.Cells(Rows.Count, "A").End(xlUp).Row
LastRowCitizens = inputWS3.Cells(Rows.Count, "A").End(xlUp).Row
lastRowGeovera = inputWS2.Cells(Rows.Count, "A").End(xlUp).Row
LastRowPolicy = outputWS.Cells(Rows.Count, "B").End(xlUp).Row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).Row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column

'Universal
inputWS1.Range("A4:A" & lastRowUniversal).Copy outputWS.Range("B2")
inputWS1.Range("B4:B" & lastRowUniversal).Copy outputWS.Range("C2")
inputWS1.Range("N4:N" & lastRowUniversal).Value = inputWS1.Name
inputWS1.Range("N4:N" & lastRowUniversal).Copy outputWS.Range("E2")
inputWS1.Range("L4:L" & lastRowUniversal).Value = inputWS1.Evaluate(Replace(dtFORM, "<r>", lastRowUniversal))
inputWS1.Range("L4:L" & lastRowUniversal).Copy outputWS.Range("G2")
inputWS1.Range("G4:G" & lastRowUniversal).Copy outputWS.Range("H2")

'Geovera

inputWS2.Range("F2:F" & lastRowGeovera).Copy outputWS.Range("B" & lastRowUniversal - 1)
inputWS2.Range("I2:I" & lastRowGeovera).Copy outputWS.Range("C" & lastRowUniversal - 1)
inputWS2.Range("P2:P" & lastRowGeovera).Value = inputWS2.Name
inputWS2.Range("P2:P" & lastRowGeovera).Copy outputWS.Range("E" & lastRowUniversal - 1)
inputWS2.Range("N2:N" & lastRowGeovera).Copy outputWS.Range("H" & lastRowUniversal - 1)
inputWS2.Range("G2:G" & lastRowGeovera).Copy outputWS.Range("G" & lastRowUniversal - 1)

'Citizens
inputWS3.Range("D2:D" & LastRowCitizens).Copy inputWS3.Range("N2:N" & LastRowCitizens)
inputWS3.Range("B2:B" & LastRowCitizens).Copy outputWS.Range("C" & lastRowGeovera + (lastRowUniversal - 2))
inputWS3.Range("M2:M" & LastRowCitizens).Value = inputWS3.Name
inputWS3.Range("M2:M" & LastRowCitizens).Copy outputWS.Range("E" & lastRowGeovera + (lastRowUniversal - 2))
inputWS3.Range("E2:E" & LastRowCitizens).Copy outputWS.Range("G" & lastRowGeovera + (lastRowUniversal - 2))
inputWS3.Range("J2:J" & LastRowCitizens).Copy outputWS.Range("H" & lastRowGeovera + (lastRowUniversal - 2))

inputWS3.Columns("N").NumberFormat = "@"

With inputWS3
For i = 2 To LastRowCitizens
    .Cells(i, "N") = Left(.Cells(i, "N").Value, 8)
Next i


End With

inputWS3.Range("N2:N" & LastRowCitizens).Copy outputWS.Range("B" & lastRowGeovera + (lastRowUniversal - 2))

'Formatting



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

The line im looking to fix is : inputWS2.Range("G2:G" & lastRowGeovera).Copy outputWS.Range("G" & lastRowUniversal - 1)

The range G2:G has the date values that i need to change to MM/DD/YYYY date format.

How can i achive this before copying to outputWS ?

Answer 1

How about a custom function?

Public Function ToDate(ByVal s As String) As Date
    ToDate = DateValue(Right(s, 2) & "/" & Mid(s, 5, 2) & "/" & Left(s, 4))
End Function

To call it:

Dim d As Date
    d = ToDate("20160812")

Answer 2

I Figured it out guys! Decided to move the new values to a new Column "Q" since running the code multiple times would ruin the data:

With inputWS2
For i = 2 To LastRowGeovera
    Y = Left(.Cells(i, "G").Value, 4)
    M = Mid(.Cells(i, "G").Value, 5, 2)
    D = Right(.Cells(i, "G").Value, 2)
    .Cells(i, "Q") = M & "/" & D & "/" & Y

Next i
End With

inputWS2.Columns("Q").NumberFormat = "mm/dd/yyyy"