• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Alter De-pivot code from a different thread

T

Tim Hanson

Member
Hello,

@Chihiro wrote this code here: http://forum.chandoo.org/threads/matrix-to-list-database.35258/#post-210731

I have tried to alter it to do a straight un-pivot of a matrix with out any conditions but have failed at it

I think I need to remove this
Code: 
For j = 2 To UBound(srcArr, 2)
            If srcArr(i, 7) = srcArr(i, j) Then
                .Item(kStr & "^" & srcArr(1, j)) = 1
            End If
        Next

I am hoping someone can help me

I have uploaded a workbook to show what I mean

Thanks for any help on this

Code: 
Sub Demo()
Dim srcArr, resArr, Key, x
Dim i As Long, j As Long
Dim kStr As String
Dim sTime As Single, eTime As Double
sTime = Timer
With Sheets("Z")
    srcArr = .Range(.Cells(1, "A"), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With

With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(srcArr)
        For j = 1 To 1
            kStr = IIf(Len(kStr) = 0, srcArr(i, j), kStr & "^" & srcArr(i, j))
        Next
        For j = 2 To UBound(srcArr, 2)
            If srcArr(i, 7) = srcArr(i, j) Then
                .Item(kStr & "^" & srcArr(1, j)) = 1
            End If
        Next
            kStr = ""
    Next
    ReDim resArr(1 To .Count, 1 To 3)
    i = 1
    For Each Key In .Keys
        x = Split(Key, "^")
        For j = 0 To UBound(x)
            resArr(i, j + 1) = x(j)
        Next
        i = i + 1
    Next
End With

Sheets("Z").Range("A1:C1").Value = Sheets("DepivotedZ").Range("A1:C1").Value
Sheets("Z").Range("D1") = "Date"
Sheets("Z").Range("A2").Resize(UBound(resArr), 3) = resArr
eTime = Timer
Debug.Print eTime - sTime
End Sub
 
Tim
What exactly isn't working as it appears to have given you the correct results?
 
Hi ,

What Chihiro's code is doing is it is converting an unpivoted list , into a matrix.

For this code , the tab named DepivotedZ is the source , and the tab named Z is the destination.

What do you want the revised code to do ? Which data should it take , and what should the output look like ?

Narayan
 
Hello,
The I manually made the data in the sheet DepivotedZ

I am trying to use the Macro to get the data from sheet Z reshaped to that in Sheet DepivotedZ
 
I have kept trying and this maybe gets me close, yet I have a feeling that I am doing something wrong here?

Code: 
Sub Demo()
Dim srcArr, resArr, Key, x
Dim i As Long, j As Long
Dim kStr As String
Dim sTime As Single, eTime As Double
sTime = Timer
With Sheets("A")
    srcArr = .Range(.Cells(1, "A"), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With

With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(srcArr)
        For j = 1 To 2
            kStr = IIf(Len(kStr) = 0, srcArr(i, j), kStr & "^" & srcArr(i, j))
        Next
        For j = 2 To UBound(srcArr, 2)
            If srcArr(i, j) <> "" Then
                .Item(kStr & "^" & srcArr(1, j)) = 1
            End If
        Next
            kStr = ""
    Next
    ReDim resArr(1 To .Count, 1 To 3)
    i = 1
    For Each Key In .Keys
        x = Split(Key, "^")
        For j = 0 To UBound(x)
            resArr(i, j + 1) = x(j)
        Next
        i = i + 1
    Next
End With

Sheets("AA").Range("A1:C1").Value = Sheets("A").Range("A1:C1").Value
'Sheets("AA").Range("D1") = "Date"
Sheets("AA").Range("A2").Resize(UBound(resArr), 3) = resArr
eTime = Timer
Debug.Print eTime - sTime

End Sub
 
If you want to try the corrected original code see below:

Code: 
Sub Demo()
Dim srcArr, resArr, Key, x
Dim i As Long, j As Long
Dim kStr As String
Dim sTime As Single, eTime As Double
sTime = Timer
Sheets("Sheet1").Range("A1").CurrentRegion.ClearContents

With Sheets("Z")
  srcArr = .Range(.Cells(1, "A"), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With

With CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(srcArr)
  For j = 1 To 1
  kStr = IIf(Len(kStr) = 0, srcArr(i, j), kStr & "^" & srcArr(i, j))
  Next
  For j = 2 To UBound(srcArr, 2)
  .Item(kStr & "^" & srcArr(1, j) & "^" & srcArr(i, j)) = 1
  Next
  kStr = ""
  Next
  ReDim resArr(1 To .Count, 1 To 4)
  i = 1
  For Each Key In .Keys
  x = Split(Key, "^")
  For j = 0 To UBound(x)
  resArr(i, j + 1) = x(j)
  Next
  i = i + 1
  Next
End With

Sheets("Sheet1").Range("A1").Value = "From"
Sheets("Sheet1").Range("B1").Value = "Issue"
Sheets("Sheet1").Range("C1").Value = "To"

Sheets("Sheet1").Range("A2").Resize(UBound(resArr), 3) = resArr
Sheets("Sheet1").Columns("A:C").EntireColumn.AutoFit
eTime = Timer
Debug.Print eTime - sTime
End Sub

or see attached file:
 

Attachments

Just for your info

I ran the last code I supplied, The modified Original code, and Narayans Code, 5 times each. Then averaged the times

Original Average
0.028125 seconds

Narayan Average
0.0625 seconds

This is only 0.04 seconds different, but it is actually about a 55% saving in time
This would get larger using a larger data set of say 100,000 rows of data or a larger number of columns

The Difference is that the original code uses a Dictionary and Narayan's uses arrays to store the intermediate results
Both read the whole range to an Array and write it back from an Array

I added the same code to both macro's to Clear the data area before running and to resize the columns after running to keep things fair
 
The main advantage in this instance to use Scripting.Dictionary, is that you can loop through using Object rather than index. There are other benefits to Scripting.Dictionary, but isn't relevant in this instance.

I don't fully understand the reason behind it, but looping through object is typically faster. Provided operation is same otherwise.

By the same token, if you need to loop through range, it is faster to loop using Cell Range object rather than row index of cells.
 
Hui said:
Just for your info

I ran the last code I supplied, The modified Original code, and Narayans Code, 5 times each. Then averaged the times

Original Average
0.028125 seconds

Narayan Average
0.0625 seconds

This is only 0.04 seconds different, but it is actually about a 55% saving in time
This would get larger using a larger data set of say 100,000 rows of data or a larger number of columns

The Difference is that the original code uses a Dictionary and Narayan's uses arrays to store the intermediate results
Both read the whole range to an Array and write it back from an Array

I added the same code to both macro's to Clear the data area before running and to resize the columns after running to keep things fair
Click to expand...
Hi ,

Your code , at least what you have posted , does not do a Sort to get it into the format Tim had shown.

Narayan
 
Narayan, thank you for your code and help

Hui, thank you for fixing the original code and the time analysis very helpful

Chihiro, thank you for the original code and your comments
 
You must log in or register to reply here.
Back
Top