VBA Excel add-in: code to change format of column from general to custom date

Question

My data provider has changed several things in the .XLSX file I get. I have added a new sub to fix the data according to the model this application expects:

Sub Feb27FixModel()
    ActiveSheet.Range("H2").End(xlDown).NumberFormat = "dd-mmm-yyyy"            'change format of Processed Date
    Dim colNum As Integer
    colNum = ActiveSheet.Rows(1).Find(what:="Legacy code", lookat:=xlWhole).Column
    ' Done twice to insert 2 new cols
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ' New col headings
    ActiveSheet.Cells(1, colNum + 1).Value = "Origin Code"
    ActiveSheet.Cells(1, colNum + 2).Value = "Jurisdiction Code"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "County Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "State Abbreviation"
    ActiveWorkbook.Save
End Sub

Everything works EXCEPT the result of the 1st line above. In the active worksheet, column H has a header row value of "Processed Date" and the H2 cell and cells below it are stored as General with values like 11/15/2016. I need to change all the dates to a custom date as dd-mmm-yyyy. The statement below fails to get this done for me:

ActiveSheet.Range("H2").End(xlDown).NumberFormat = "dd-mmm-yyyy"

EDIT (01March2017):

Thanks to the answer from @Jeeped below, I added another statement and this is the code that was the solution:

With ActiveSheet
    .Range(.Cells(2, "H"), .Cells(.Rows.Count, "H").End(xlUp)).NumberFormat = "dd-mmm-yyyy"
    .Range(.Cells(2, "H"), .Cells(.Rows.Count, "H").End(xlUp)).Value = ActiveCell.Text
End With

EDIT (02March2017):

I made a mistake yesterday. In debugging, I must have had a good cell selected in the worksheet at a breakpoint; hence, refering to ActiveCell.Text "sort of worked". It had the effect of replicating the Text to be "14-Oct-2016" in EVERY row for column H (except the first row). This was minimally acceptable.

What I really need is a statement that will take the Text of all rows of column H and change the stored value from displaying as 10/14/2016 to 14-Oct-2016, etc. It is not enough to just change the format to custom. I need to change the stored values too. I don't know how to do that.

See [How to avoid using Select in Excel VBA macros](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). — , Feb 28 '17 at 23:14

score 2 · Accepted Answer · answered Feb 28 '17 at 23:17

2

You are only operating on the last cell with a value in column H. Span from H2 to the last cell to set the format of all of the cells.

with ActiveSheet
    .Range(.cells(2, "H"), .cells(.rows.count, "H").End(xlUp)).NumberFormat = "dd-mmm-yyyy"
end with

answered Feb 28 '17 at 23:17

Thank you. I replaced my attempt above with your code and ran the whole new addin. The values of the cells in column H remain as before (i.e. a typical value is shown as 11/22/2016). Yet when I click on one of the cells in column H and chose "Format Cells", the format has indeed been changed from General to Custom and dd-mmm-yyyy. Is there another statement needed to actually "apply" the new format to the cell value so it would display as 22-Nov-2016? – John Adams Mar 01 '17 at 18:56
It would appear that your dates are not true dates at all; merely text that looks like dates. Select the column and use Data, Text-to-Columns and select the correct MDY format on the third screen. Additionally, this needs to be done on future imports when you bring in new data. – Mar 01 '17 at 19:57
Thank you. See my EDIT of OP above. Your answer helped greatly. – John Adams Mar 01 '17 at 20:03
Please see my EDIT above. I still need your help. – John Adams Mar 02 '17 at 19:56

ThomasMX · Answer 2 · 2017-03-01T08:05:14.080

0

This four-line-loop should do the trick. Tested it. ;)

For i = 2 To Columns("H").End(xlDown).Row 'from row nr 2 to the rownr of last cell of column H
    Set currentCell = Cells(i, "h")
    currentCell.Value = Format(currentCell.Value, "dd-mm-yyyy")
Next i

It strolls though each cell and applies the Format() function on them to convert the text format. Let me know if that helps.

edited Mar 01 '17 at 08:05

answered Mar 01 '17 at 07:59

ThomasMX

1,643
2
19
35

Thanks. Got compile error(s) trying your suggestion. So I added: Dim i as Integer then dim currentCell as Object in front of For loop. Then I got error code 6 overflow. – John Adams Mar 01 '17 at 19:44

score 0 · Answer 3 · answered Mar 12 '18 at 23:36

0

Just solved this for the same issue you have. Tested your case as well. The key is the TextToColumns command. With your code, give this a try:

With ActiveSheet.Range("H:H")
    .NumberFormat = "dd-mmm-yyyy"
    .TextToColumns
End With

answered Mar 12 '18 at 23:36

Wayne

381
1
3
12

score -1 · Answer 4 · edited Jul 02 '21 at 12:19

Sub Letsgive_try1()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, Fnum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    

    'paste your path here
    MyPath = "C:\Users\ThakareK\Documents\Box Support Files\Voice Acq\"

    'Just for safer side if you forget to add \
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    'to check all excel files in you files folder directory
    FilesInPath = Dir(MyPath & "*.csv*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Add a new workbook with name test you can change as per yours below
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        ActiveWorkbook.SaveAs Filename:="Test.xlsx"
    rnum = 1

    'Main part starts here Loop through all files in the array(myFiles)
    'if you want to change data format add your range of cell and give date fomrat of your need
    
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
            mybook.Activate
            
            
            'this part copies dynamic data
            Range("A1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
            
          
            'this part pastes data in new excel we genertaed
            Windows("TEST.xlsx").Activate
           
            With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(0)
           .PasteSpecial Paste:=xlPasteColumnWidths
           .PasteSpecial Paste:=xlPasteValues
            End With
            
            
            'if you want to change data format add your range of cell instead of(G:G) and give date fomrat of your need
            With ActiveSheet.Range("G:G")
           .NumberFormat = "mm-dd-yyyy"
           .TextToColumns
            End With
            
            mybook.Close savechanges:=False
            
            On Error GoTo 0

               

        Next Fnum
        BaseWks.Columns.AutoFit
    End If

ExitTheSub:
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

Can you give a little more context to your answer. Also, please format your code. — Eliot K, Jun 29 '21 at 19:58

VBA Excel add-in: code to change format of column from general to custom date

4 Answers4