Option Explicit
Sub Demo()
Dim myArr, x
Dim i As Long, j As Long
Dim colIndex As String
myArr = Sheet1.UsedRange.Value
For i = 1 To UBound(myArr)
For j = 1 To UBound(myArr, 2)
If myArr(i, j) Like "[0-9][0-9].[0-9][0-9].[0-9][0-9][0-9][0-9]" Then
x = Split(myArr(i, j), ".")
If InStr(1, colIndex, j) = 0 Then colIndex = IIf(Len(colIndex) = 0, j, colIndex & "," & j)
myArr(i, j) = DateSerial(x(2), x(1), x(0))
End If
Next
Next
x = Split(colIndex, ",")
With Sheet1
.UsedRange = myArr
For i = 0 To UBound(x)
.Columns(CLng(x(i))).NumberFormat = "dd/mm/yyyy"
Next
End With
End Sub
This will typically happen if the OP's actual data has cell containing Excel Error value like #N/A, #VALUE.
List ALL of the possibilities that the header could contain that might signify it's a date column. That is, complete this list (it doesn't matter about upper/lower case at the moment):
If rng.Value Like "[0-9][0-9].[0-9][0-9].[0-9][0-9][0-9][0-9]" ThenIf rng.Value Like "[0-9][0-9].[0-9][0-9].[0-9][0-9][0-9][0-9]" or rng.Value Like "[0-9][0-9].[0-9][0-9].[0-9][0-9]" Then
I showed the correct syntax for the line you mentioned wasn't working.
Public Sub ReplaceDotWithSlash()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.Value Like "[0-9][0-9].[0-9][0-9].[0-9][0-9][0-9][0-9]" Then
rng.Value = DateValue(Mid(rng.Value, 4, 2) & "/" & Mid(rng.Value, 1, 2) & "/" & Mid(rng.Value, 7, 4))
ElseIf rng.Value Like "[0-9][0-9].[0-9][0-9].[0-9][0-9]" Then
rng.Value = DateValue(Mid(rng.Value, 4, 2) & "/" & Mid(rng.Value, 1, 2) & "/" & Mid(rng.Value, 7, 2))
End If
Next
End SubOption Explicit
Sub Demo()
Dim myArr, x
Dim i As Long, j As Long
Dim colIndex As String
myArr = Sheet1.UsedRange.Value
For i = 1 To UBound(myArr)
For j = 1 To UBound(myArr, 2)
If myArr(i, j) Like "[0-9][0-9].[0-9][0-9].[0-9][0-9][0-9][0-9]" Then
x = Split(myArr(i, j), ".")
If InStr(1, colIndex, j) = 0 Then colIndex = IIf(Len(colIndex) = 0, j, colIndex & "," & j)
myArr(i, j) = DateSerial(x(2), x(1), x(0))
ElseIf myArr(i, j) Like "[0-9][0-9].[0-9][0-9].[0-9][0-9]" Then
x = Split(myArr(i, j), ".")
If InStr(1, colIndex, j) = 0 Then colIndex = IIf(Len(colIndex) = 0, j, colIndex & "," & j)
myArr(i, j) = DateSerial(x(2) + 2000, x(1), x(0))
End If
Next
Next
x = Split(colIndex, ",")
With Sheet1
.UsedRange = myArr
For i = 0 To UBound(x)
.Columns(CLng(x(i))).NumberFormat = "dd/mm/yyyy"
Next
End With
End SubIn the file you've attached all date column headers have the full word Date in them so the snippet of code in msg#22 works on your most recent sheet. It doesn't matter whether there are 2 digit years or 4 digit years.
