Guinaba
Board Regular
- Joined
- Sep 19, 2018
- Messages
- 233
- Office Version
- 2016
- Platform
- Windows
Hi guys,
I am using the below code to copy a range to a table, however some dates are incorrectly converting from dd/mm/yyyy to mm/dd/yyyyy:
Is there any way to avoid that happening?
I am using the below code to copy a range to a table, however some dates are incorrectly converting from dd/mm/yyyy to mm/dd/yyyyy:
| Range (Correct date) | Table (incorrect date) |
| 01/07/2024 | 07/01/2024 |
| 05/08/2024 | 08/05/2024 |
| 12/08/2024 | 08/12/2024 |
Is there any way to avoid that happening?
VBA Code:
Sub Data_Array_Set_IBPData_1(vDtaHdr() As Variant, vDtaBdy() As Variant)
Dim wrksht As Worksheet
Dim objListObj As ListObject
Dim vArray As Variant
'Find the last non-blank cell in column A(1)
LRow = ThisWorkbook.Worksheets("IBP Data").Cells(Rows.Count, 2).End(xlUp).Row
With ThisWorkbook.Worksheets("IBP Data").Range(ThisWorkbook.Worksheets("IBP Data").Cells(2, 1), ThisWorkbook.Worksheets("IBP Data").Cells(LRow, 8))
vArray = .Rows(1)
vDtaHdr = vArray
vArray = .Offset(1, 0).Resize(-1 + .Rows.Count)
vDtaBdy = vArray
End With
End Sub
Sub IBPData_1()
Dim MyTable As ListObject
Dim vDtaHdr() As Variant, vDtaBdy() As Variant
Dim lRowsAdj As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set MyTable = ThisWorkbook.Worksheets("IBP Data").ListObjects("tFcst_1") 'Change as required
Call Data_Array_Set_IBPData_1(vDtaHdr, vDtaBdy)
With MyTable.DataBodyRange
Rem Get Number of Rows to Adjust
lRowsAdj = 1 + UBound(vDtaBdy, 1) - LBound(vDtaBdy, 1) - .Rows.Count
Rem Resize ListObject
If lRowsAdj < 0 Then
Rem Delete Rows
.Rows(1).Resize(Abs(lRowsAdj)).Delete xlShiftUp
ElseIf lRowsAdj > 0 Then
Rem Insert Rows
.Rows(1).Resize(lRowsAdj).Insert Shift:=xlDown
End If: End With
Rem Overwrite Table with New Data
MyTable.HeaderRowRange.Value = vDtaHdr
MyTable.DataBodyRange.Value = vDtaBdy
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Table has been refreshed", vbInformation
End Sub
just ran the code including your suggestion, not sure I am missing something, but didn't worked 
