-1

Looping a macro that changes date format in column A to column C then continue until it's reached the last used cell in column A.

I can only get it to change the date in A1 - I need it to loop down until column A is blank:

Sub Macro1()
  '
  ' Macro1 Macro
  Dim ShipDate, Temp, DateForImport
  Set ShipDate = Range("A1") ' or whatever cell the date is entered into (D30)

  For I = 1 To 1
    On Error Resume Next
    Set Temp = Range("A1")

    If Len(Temp.Text) > 1 Then
      Set TempDate = Temp
      'FORMAT SHIP DATE From MM/DD/YY OR MM/DD/YYYY TO YYYY-MM-DD
      'if single digit month or day then fix it
      If Len(TempDate.Text) = 10 Then
        TempDate = TempDate
        Exit For
      End If
      'case M/DD/YYYY length 9
      If Len(TempDate.Text) = 9 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Right(TempDate, 9)
        Exit For
      End If
      'case MM/D/YYYY length 9
      If Len(TempDate.Text) = 9 And Mid(TempDate, 3, 1) = "/" Then
        TempDate = Left(TempDate, 3) + "0" + Right(TempDate, 6)
        Exit For
      End If
      'case MM/DD/YY length 8
      If Len(TempDate.Text) = 8 And Mid(TempDate, 3, 1) = "/" Then
        TempDate = Left(TempDate, 6) + "20" + Right(TempDate, 2)
        Exit For
      End If
      'case M/D/YYYY length 8
      If Len(TempDate.Text) = 8 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Left(TempDate, 2) + "0" + Right(TempDate, 6)
        Exit For
      End If
      'case M/DD/YY length 7
      If Len(TempDate.Text) = 7 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Left(TempDate, 2) + Mid(TempDate, 3, 3) + "20" + Right(TempDate, 2)
        Exit For
      End If
      'case MM/D/YY length 7
      If Len(TempDate.Text) = 7 And Mid(TempDate, 3, 1) = "/" Then
        TempDate = Left(TempDate, 3) + "0" + Mid(TempDate, 4, 2) + "20" + Right(TempDate, 2)
        Exit For
      End If
      'case M/D/YY length 6
      If Len(TempDate.Text) = 6 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Left(TempDate, 2) + "0" + Mid(TempDate, 3, 2) + "20" + Right(TempDate, 2)
        Exit For
      End If

      'MsgBox "found Ship Date:  " + ShipDate
      Exit For
    End If

  Next I

  DateForImport = "20" + Right(TempDate, 2) + Left(TempDate, 2) + Mid(TempDate, 4, 2)
  Range("C1") = DateForImport

End Sub
Community
  • 1
  • 1
Brenda G.
  • 1
  • 2
  • I can only get it to change the date in A1 - I need it to loop down until column A is blank – Brenda G. Apr 12 '17 at 13:49
  • `For I = 1 To 10 Set Temp = Range("A" & I)`? That for the first 10 rows. For finding last row, see [here](http://stackoverflow.com/a/71310/1726522). – CMArg Apr 12 '17 at 15:07

1 Answers1

0

You will first need to define your last row as below and then set your temp range. Try substituting this into your macro and run through it. 

    lRow = WorksheetFunction.Max(Range("A65536").End(xlUp).Row)

    With ActiveSheet
    For i = lRow To 2 Step -1
    On Error Resume Next
    Set Temp = Range("A" & i)
Joe W
  • 111
  • 4