Home > Software design >  Excel VBA Transpose date
Excel VBA Transpose date

Time:01-14

I'm currently doing one macro to transpose table 1 to table 2. I've manage to transpose the data, but I've encounter one issue regarding the date. From table 1, the date was 8th of January 2022, but once I transpose the table, the date changed to 1st of August 2022 instead. May I ask for guidance to see is there any mistake in my coding? Your help is much appreciated.

Sub ImportData()

   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   ' Select excel Sheet command
   Set Sht = ActiveSheet
   Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
   If Fname = "False" Then Exit Sub
   Set Wbk = Workbooks.Open(Fname)
   
   ' Transpose Data
   Sht.Range("A1:F3").Value = Application.Transpose(Wbk.Sheets("Sheet1").Range("A1:C6").Value)
   Wbk.Close False
   
   
   
End Sub

Table 1 :

Company Item Date 8/1/2022 15/2/2022 25/3/2022
ABC LTD Desktop Cust demand 6204 9600 19904
ABC LTD Desktop Shipped qty 6204 9600 19904

Table 2:

Company ABC LTD ABC LTD
Item Desktop Desktop
Date Cust Demand Shipped qty
1/8/2022 6204 6204
15/2/2022 9600 9600
25/3/2022 19904 19904

I tried format the date on both worksheet to the same format but was unable to solve the issue.

CodePudding user response:

Your problem likely stems from the fact that VBA date handling is US Centric (MDY), even though your regional settings are DMY.

One workaround is to use the FormulaLocal property of the Range object rather than the .Value property.

Another workaround is to just not use WorksheetFunction.Transpose, but rather use a custom function, as described by @VBasic2008

WorksheetFunction.Transpose has another limitation if the size of the range to be transposed is greater than 2^16-1, so I frequently try to avoid it.

CodePudding user response:

Transpose Range Values

  • Someone once told me that transpose has issues with dates. I never experienced this on my own but I usually write a function or sub for such a task.

  • Try the following method and possibly prove that the previous is true and share some feedback.

  • In your sub, you can use it in the following way:

    TransposeRange Wbk.Sheets("Sheet1").Range("A1:C6"), Sht.Range("A1")
    
  • BTW your sub works correctly on my end.

The Method

Sub TransposeRange( _
        ByVal SourceRange As Range, _
        ByVal FirstDestinationCell As Range) _
    
    Dim sData(), srCount As Long, scCount As Long
    
    With SourceRange
        srCount = .Rows.Count
        scCount = .Columns.Count
        If srCount * scCount = 1 Then
            ReDim sData(1 To 1, 1 To 1): sData(1, 1).Value = .Value
        Else
            sData = .Value
        End If
    End With
        
    Dim dData(): ReDim dData(1 To scCount, 1 To srCount)
        
    Dim sr As Long, sc As Long
        
    For sr = 1 To srCount
        For sc = 1 To scCount
            dData(sc, sr) = sData(sr, sc)
        Next sc
    Next sr
    
    FirstDestinationCell.Resize(scCount, srCount).Value = dData
    
End Sub
  • Related