Reputation: 29
I transpose table 1 to table 2.
I encountered 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.
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 formatting the dates on both worksheets to the same format.
Upvotes: 1
Views: 162
Reputation: 60224
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.
Upvotes: 1
Reputation: 54815
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
Upvotes: 0