I'm not happy about my code, but is the better way that I find, I'm not happy because I see that there are many code repetitions and when any change is easy to make mistakes. Do you think you can do better?Any suggestions are welcomeSub ConvDateD(c As Integer)Application.ScreenUpdating = FalseDim lrw As Long, i As Long, NrArr As IntegerDim ArrVal As Variant, tempArr() As VariantDim MaxVal As Long, StartVal As Long, RangeVal As LongDim avvio As Date, arresto As Date, tempo As Dateavvio = NowStartVal = 2MaxVal = 65000RangeVal = 65000lrw = ActiveSheet().Cells(1, c).End(xlDown).RowIf (lrw / MaxVal) - Int(lrw / MaxVal) > 0 Then    NrArr = (lrw / MaxVal) + 1Else    NrArr = lrw / MaxValEnd IfIf NrArr = 1 Then    ReDim ArrVal(StartVal To lrw)    For i = StartVal To lrw        If IsDate(Cells(i, c)) Then            ArrVal(i) = Cells(i, c)        Else            Select Case Len(Cells(i, c))                 Case 8                    ArrVal(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                Case 6                    ArrVal(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))            End Select        End IfNextX:    Next iElse    For a = 1 To NrArr    Select Case a    Case 1        ReDim tempArr1(2 To MaxVal)        For i = StartVal To MaxVal            If IsDate(Cells(i, c)) Then                tempArr1(i) = Cells(i, c)            Else                Select Case Len(Cells(i, c))                    Case 8                        tempArr1(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                    Case 6                        tempArr1(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))                End Select            End If        Next i        Range(Cells(StartVal, c), Cells(MaxVal, c)) = WorksheetFunction.Transpose(tempArr1)            StartVal = MaxVal + 1           If StartVal + RangeVal < lrw Then MaxVal = StartVal + RangeVal Else MaxVal = lrw    Case 2        ReDim tempArr2(StartVal To MaxVal)        For i = StartVal To MaxVal            If IsDate(Cells(i, c)) Then                tempArr2(i) = Cells(i, c)            Else                Select Case Len(Cells(i, c))                    Case 8                        tempArr2(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                    Case 6                        tempArr2(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))                End Select            End If        Next i        Range(Cells(StartVal, c), Cells(MaxVal, c)) = WorksheetFunction.Transpose(tempArr2)           StartVal = MaxVal + 1           If StartVal + RangeVal < lrw Then MaxVal = StartVal + RangeVal Else MaxVal = lrw    Case 3        ReDim tempArr3(StartVal To MaxVal)        For i = StartVal To MaxVal            If IsDate(Cells(i, c)) Then                tempArr1(i) = Cells(i, c)            Else                Select Case Len(Cells(i, c))                    Case 8                        tempArr3(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                    Case 6                        tempArr3(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))                End Select            End If        Next i       Range(Cells(StartVal, c), Cells(MaxVal, c)) = WorksheetFunction.Transpose(tempArr3)            StartVal = MaxVal + 1           If StartVal + RangeVal < lrw Then MaxVal = StartVal + RangeVal Else MaxVal = lrw    Case 4        ReDim tempArr4(StartVal To MaxVal)        For i = StartVal To MaxVal            If IsDate(Cells(i, c)) Then                tempArr1(i) = Cells(i, c)            Else                Select Case Len(Cells(i, c))                    Case 8                        tempArr4(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                    Case 6                        tempArr4(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))                End Select            End If        Next i       Range(Cells(StartVal, c), Cells(MaxVal, c)) = WorksheetFunction.Transpose(tempArr4)            StartVal = MaxVal + 1           If StartVal + RangeVal < lrw Then MaxVal = StartVal + RangeVal Else MaxVal = lrw    Case 5        ReDim tempArr5(StartVal To MaxVal)        For i = StartVal To MaxVal            If IsDate(Cells(i, c)) Then                tempArr1(i) = Cells(i, c)            Else                Select Case Len(Cells(i, c)) ' to check YYYYMMDD or YYMMDD                    Case 8                        tempArr5(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                    Case 6                        tempArr5(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))                End Select            End If        Next i       Range(Cells(StartVal, c), Cells(MaxVal, c)) = WorksheetFunction.Transpose(tempArr5)            StartVal = MaxVal + 1           If StartVal + RangeVal < lrw Then MaxVal = StartVal + RangeVal Else MaxVal = lrw    Case 6        ReDim tempArr6(StartVal To MaxVal)        For i = StartVal To MaxVal            If IsDate(Cells(i, c)) Then                tempArr1(i) = Cells(i, c)            Else                Select Case Len(Cells(i, c)) ' to check YYYYMMDD or YYMMDD                    Case 8                        tempArr6(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))                    Case 6                        tempArr6(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))                End Select            End If        Next i       Range(Cells(StartVal, c), Cells(MaxVal, c)) = WorksheetFunction.Transpose(tempArr6)            StartVal = MaxVal + 1           If StartVal + RangeVal < lrw Then MaxVal = StartVal + RangeVal Else MaxVal = lrw    End SelectNext aEnd Ifarresto = Nowtempo = arresto - avvioDebug.Print tempoColumns(c).NumberFormat = DD/MM/YYYY;@Columns(c).EntireColumn.AutoFitApplication.ScreenUpdating = TrueEnd Sub
Converting values to Dates in column
array;vba