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