Copying range to table

Guinaba

Board Regular
Joined
Sep 19, 2018
Messages
226
Office Version
  1. 2016
Platform
  1. 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:

Range (Correct date)Table (incorrect date)
01/07/202407/01/2024
05/08/202408/05/2024
12/08/202408/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
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
It indicates that your dates in the original range are being recognised as Text.
Unless you have a reason to not convert it in the original range, do a Text to Columns conversion in the macro.
Since the date format is your default format either using General or Date (with DMY) will work.
 
Upvote 0

Forum statistics

Threads
1,221,544
Messages
6,160,428
Members
451,645
Latest member
androidmj

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top