Solved

Date format when printing to CSV

  • 17 January 2023
  • 6 replies
  • 98 views

Hello,

Not sure how many of you work with ‘printing’ reports to .csv and then opening the .csv files in Excel.

This is the situation.

We run WIP report for a period to csv, then we run a macro which deletes whatever columns are not needed, creates formulas to correct dates imported as text or as date, format number, insert subtotals, etc., leaving a clean report.

We do that on many reports.

Since there are thousands of lines, I never noticed that Excel incorrectly presents the date. Duh!

In the attached picture entries in columns for month, day and year are separated from the date dumped to csv using the Text to Columns function. Then the DATE formula uses those to create a date. Expected date, as in the picture is 2018 December 31.
It turns out that Excel produces number 44024 which is in fact Jul 12th 2020.

Did anyone encounter such behaviour and found a solution?

icon

Best answer by wzalewski 30 January 2023, 18:59

View original

6 replies

Your formula is wrong.  You’re pulling the month into the Day parameter and the day into the month parameter.  I just replicated this in Excel and I can see it in your formula.  Make the Day column D and the month column C and it should calc the date properly.  Let me know if this resolves it or if I’m missing something.

Thanks,

Kevin

Hi Kevin.

Thank you for noticing, which I did not even look at.

The issue is completely different here, after I read that the formula is wrong.

Please take a look at the second attached screenshot.
At row 3798 the date changes spots in each column. Macro enters formula in row 2, below the headers and never expects the change in date at some point.

Screenshot 3 shows the date formatting as it is opened in Excel.
I will change the formula to account for the changes and it will be fine.

 

Thank you for your help.

Wes

 

Userlevel 1

Nothing additionally to include but thanks for the idea of using a macro to cleanup OTS reports.

-Anthony

Userlevel 3

Wes,

Looks like you need to copy the correct formula all the way down through the spreadsheet.  The formula may have been changed by someone, that thought the month and day columns were reversed in an earlier version of the spreadsheet.

Thank you for noticing. I wasn't even thinking about it.

However, the formula is not wrong.


The .csv file coming from Epicor changes the format in the date field.

At the top when macro enters formula the result is correct. Then copied down creates a wrong date because the format in the file is wrong.

Please take a look at the two attached screenshots.


I change the formula in the macro to accommodate the length of entry in the original cell and choose the correct Y/M/D selection.

Works like a charm.

Thank you.

 

 

 

Maybe someone can clean it for me:

 

Sub WipPrep()

    Application.ScreenUpdating = False
    
    
    Call MoveWIPSum
    Call DelWipColumns
    Call WIPColWidths
    Call WIPFormulas
    Call InsertYM
    
    Application.ScreenUpdating = True
    Range("A2").Select
    
    MsgBox "Done"
    
End Sub

Sub MoveWIPSum()

    Application.ScreenUpdating = False
    
    ActiveSheet.Name = "WIP"
    
    Range("A1").End(xlDown).End(xlDown).Select
    ActiveCell.CurrentRegion.Select
    
    Selection.Cut
    
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    
    Columns("A:L").Select
    Range("L1").Activate
    Columns("A:L").EntireColumn.AutoFit
    
' Delete columns
    Range("J1:L1").Select
    Selection.EntireColumn.Delete
    
    Range("A1:E1").Select
    Range("E1").Activate
    Selection.EntireColumn.Delete
    
    Range("A1").Select
    
    ActiveSheet.Name = "SUM"
    ActiveWindow.DisplayGridlines = False
    
    Range("A1:D1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = True
    End With
    
' Find the last non-blank cell in column A(1)
    Dim lRow As Long
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
'    MsgBox lRow
    
' Enter Totals
    Range("B" & lRow + 2).Formula = "=Sum(B1:B" & lRow & ")"
    Range("C" & lRow + 2).Formula = "=Sum(C1:C" & lRow & ")"
    
' Format Totals
    Range("B" & lRow + 2, "C" & lRow + 2).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = True
    End With
        
    Range("B2:C" & lRow).Select
    Call WZ_Numbers
    
    Range("A1").Formula = "Account"
    Range("B1").Formula = "DR"
    Range("C1").Formula = "CR"
    Range("D1").Formula = "Description"
    
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.DisplayZeros = False
    
    Application.ScreenUpdating = True
        
End Sub

Sub DelWipColumns()

    Application.ScreenUpdating = False

    Sheets("WIP").Select
    
    Range("A1").Select
    Selection.EntireColumn.Delete
    
' Insert column
    Range("B1").Select
    Selection.EntireColumn.Insert
    Range("A2").Select
        
' Text to column
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select

    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    
   
' Delete columns
    Range("L1:X1").Select
    Selection.EntireColumn.Delete

    Application.ScreenUpdating = True
    
End Sub

Sub WIPColWidths()

    Application.ScreenUpdating = False
    

    Range("A1").Select
    Selection.ColumnWidth = 13
    
    Range("B1").Select
    Selection.ColumnWidth = 32
    
    Range("C1").Select
    Selection.ColumnWidth = 14
    
    Range("D1").Select
    Selection.ColumnWidth = 10
    
    Range("E1").Select
    Selection.ColumnWidth = 9
    
    Range("F1").Select
    Selection.ColumnWidth = 12
    
    Range("G1").Select
    Selection.ColumnWidth = 14
    
    Range("H1").Select
    Selection.ColumnWidth = 14

    Range("I1").Select
    Selection.ColumnWidth = 48
    
    Range("J1").Select
    Selection.ColumnWidth = 14

    Range("K1").Select
    Selection.ColumnWidth = 32
    
    Range("L1").Select
    Selection.ColumnWidth = 15
    
    Range("M1").Select
    Selection.ColumnWidth = 15
    
    Range("N1").Select
    Selection.ColumnWidth = 15
    
    Range("O1").Select
    Selection.ColumnWidth = 15
    
    
    Range("A1").Formula = "Account"
    Range("B1").Formula = "Name"
    Range("C1").Formula = "Apply Date"
    Range("D1").Formula = "Trn Type"
    Range("E1").Formula = "Posted"
    Range("F1").Formula = "JobNum"
    Range("G1").Formula = "DR"
    Range("H1").Formula = "CR"
    Range("I1").Formula = "Reference"
    Range("J1").Formula = "System Date"
    Range("K1").Formula = "PartNum"
    Range("L1").Formula = "PartID"
    
    Range("A1:O1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = True
    End With
    
    ActiveWindow.DisplayGridlines = False
    
    Range("A1").Select
    ActiveCell.CurrentRegion.Select
    Call WZ_Borders
    
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    
    
    
    
' Find the last non-blank cell in column A(1)
    Dim lRow As Long
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
'    MsgBox lRow
        
        
        
' ****************************
' Format date in Column C
' 1 Convert the column to text
' 2 Insert columns
' 3 Separate entries by /
' 4 Enter formula to create correct date
' 5 Copy formula down
' 6 Format the copied data to date
' 7 Copy values to column C
' 8 Delete helping columns

' =DATE(RIGHT(C2,4),MID(C2,4,2),LEFT(C2,2))


    Range("D1").Select
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    
    Range("D1").Formula = "1"
    Range("E1").Formula = "2"
    Range("F1").Formula = "3"
    Range("G1").Formula = "4"
    Range("H1").Formula = "5"
    
    Range("H2").Formula = "=Len(C2)"
    Range("H2").Copy
    Range("H3", "H" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Calculate
    
    Range("H2", "H" & lRow).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
        
    Range("H2", "H" & lRow).Select
    Selection.NumberFormat = "General"
    
    
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True

    Application.DisplayAlerts = False
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    Range("F2").Select
    Application.DisplayAlerts = True
    
    Range("C2", "H" & lRow).Select
    Selection.NumberFormat = "General"
    
    
'    Range("F2").Select
    Range("F2").Formula = "=IF(H2<9,DATE(E2,D2,C2),DATE(E2,C2,D2))"
    Range("F2").Copy
    Range("F3", "F" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("F2:F" & lRow).Select
    Selection.NumberFormat = "dd-mmm-yyyy"
        
    Range("F2:F" & lRow).Copy
    Range("C2", "C" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.NumberFormat = "dd-mmm-yyyy"
    
    Range("D1:H1").Select
    Selection.EntireColumn.Delete
    
' ****************************
    
        
' ****************************
' Below is code to convert dates with differen formats in cells.

' Format date in Column N
' 1 Convert the column to text
' 2 Insert columns
' 3 Separate entries by /
' 4 Enter formula to create correct date
' 5 Copy formula down
' 6 Format the copied data to date
' 7 Copy values to column N
' 8 Delete helping columns

    Range("K1").Select
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    
    Range("K1").Formula = "1"
    Range("L1").Formula = "2"
    Range("M1").Formula = "3"
    Range("N1").Formula = "4"
    Range("O1").Formula = "5"
    
    Range("O2").Formula = "=Len(J2)"
    Range("O2").Copy
    Range("O3", "O" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Calculate
    
    Range("O2", "O" & lRow).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
        
    Range("O2", "O" & lRow).Select
    Selection.NumberFormat = "General"
    
    
    
    Range("J2").Select
    Range("J2", "J" & lRow).Select

    Selection.TextToColumns Destination:=Range("J2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True

    Application.DisplayAlerts = False
    Range("J2").Select
    Range("J2", "J" & lRow).Select
    Selection.TextToColumns Destination:=Range("J2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    Range("J2", "N" & lRow).Select
    Selection.NumberFormat = "General"
    Range("M2").Select
    Application.DisplayAlerts = True
    
    
'    Range("P2").Select
    Range("M2").Formula = "=IF(O2<9,DATE(L2,K2,J2),DATE(L2,J2,K2))"
    Range("M2").Copy
    Range("M3", "M" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("M2:M" & lRow).Select
    Selection.NumberFormat = "dd-mmm-yyyy"
        
    Range("M2:M" & lRow).Copy
    Range("J2", "J" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.NumberFormat = "dd-mmm-yyyy"
    
    Range("K1:O1").Select
    Selection.EntireColumn.Delete
    
' ****************************
    
    
    Range("C2:C" & lRow).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = False
    End With
    
    Range("E2:F" & lRow).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = False
    End With
    
    Range("K2:K" & lRow).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = False
    End With
    
    Range("G2:H" & lRow).Select
    Call WZ_Numbers
    
    ActiveWindow.DisplayZeros = False
    
    Range("A2").Select
    
    Application.ScreenUpdating = True
        
'    MsgBox "Done"
    
End Sub

Sub WIPFormulas()

    Sheets("WIP").Select

' Enter formula in L2 to check the format of a cell, and if PartNum cell is less than 1

' Step1
'    Range("L2").Formula = "=LEFT(@CELL(""format"",K2))=""D"""
' Step2
'    Range("L3").Formula = "=IF(LEFT(@CELL(""format"",K3))=""D"",1,2)"
' Step3 ready formula
    Range("L2").Formula = "=IF(K2<1,5,IF(LEFT(@CELL(""format"",K2))=""D"",1,2))"
     
    
    
    
' Enter formula in M2 to display correct PartNum

' Step1
'    Range("M2").Formula = "=RIGHT(TEXT(K2,""dd-mm-yyyy""),7)"
    Range("M2").Formula = "=IF(L2=5,RIGHT(K2,6),IF(L2=1,RIGHT(TEXT(K2,""dd-mm-yyyy""),7),K2))"
    
    
    
' Find the last non-blank cell in column A(1)
    Dim lRow As Long
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
'    MsgBox lRow

' Copy formulas from L2 and M2 down
    Range("L2:M2").Copy
    Range("L3", "L" & lRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' Copy formulas and paste as values
    
    Range("L2", "M" & lRow).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    Range("M2", "M" & lRow).Select
    Selection.Copy
    Range("L2").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("M1").Select
    Selection.EntireColumn.Delete
    
    
    Range("L2", "L" & lRow).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = False
    End With

    Application.CutCopyMode = False
   
    Range("B2").Select
    
'    Selection.AutoFilter
'    Selection.AutoFilter
    
    Range("K1").Select
    Selection.EntireColumn.Delete
    
    Range("K1").Select
    Selection.ColumnWidth = 32
    
    Range("J2:J" & lRow).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = False
    End With
        
End Sub

Sub InsertYM()

' Find the last non-blank cell in column A(1)
    Dim lRow As Long
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
'    MsgBox lRow

    Range("B1").Select
'    Selection.AutoFilter

    Range("L1").Formula = "Year"
    Range("M1").Formula = "Month"
    
    Range("L2").Formula = "=YEAR(C2)"
    Range("M2").Formula = "=MONTH(C2)"
    
    Range("L2:M2").Select
    Selection.Copy
    Range("L3", "M" & lRow).Select
    ActiveSheet.Paste
    
    Range("L2", "M" & lRow).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("N1").Select
    Range("N1").Formula = "Balance"
    Range("N2").Select
    Range("N2").Formula = "=G6-H6"
    Selection.Copy
    Range("N3", "N" & lRow).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("A1").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Range("A5").Select
    ActiveCell.CurrentRegion.Select
    Call WZ_Borders
    
    Range("L1").Select
    Selection.ColumnWidth = 6
    Range("M1").Select
    Selection.ColumnWidth = 6
    Range("N1").Select
    Selection.ColumnWidth = 12
    
' Using variables to build a string and assigning it to "Formula" property
    Dim strFormula As String
    Dim cell As Range
    Dim fromRow As Integer, toRow As Long
    Dim lRow2 As Long
    
    lRow2 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range("N3").Select
    Set cell = Range("N3")
    fromRow = 6
    toRow2 = lRow2
    strFormula = "=SUBTOTAL(9,N" & fromRow & ":N" & toRow2 & ")"
    cell.Formula = strFormula
    
    Range("G3").Select
    Set cell = Range("G3")
    fromRow = 6
    toRow2 = lRow2
    strFormula = "=SUBTOTAL(9,G" & fromRow & ":G" & toRow2 & ")"
    cell.Formula = strFormula
    
    Range("H3").Select
    Set cell = Range("H3")
    fromRow = 6
    toRow2 = lRow2
    strFormula = "=SUBTOTAL(9,H" & fromRow & ":H" & toRow2 & ")"
    cell.Formula = strFormula
    
    Range("G3,H3,N3").Select
    Range("N3").Activate
    Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A5").Select
    Selection.AutoFilter
    
    Application.DisplayAlerts = False
    Sheets("SUM").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    Range("A6").Select
    
End Sub

Sub SortTest()
'
    ActiveWorkbook.Worksheets("WIP").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("WIP").Sort.SortFields.Add2 Key:=Range("C2:C223017" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("WIP").Sort.SortFields.Add2 Key:=Range("I2:I223017" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("WIP").Sort
        .SetRange Range("A1:L223017")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
End Sub
 

Sub WZ_Borders()

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    
        
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

End Sub

Sorry, but Glen’s answer is incorrect.

 

Reply