asked on

VBA - Help with existing flatten file

I originally post this question and someone provided assistance with an example. I tried adding another column without much success.

Originally this is my data:

This was my intended output:

The provided code works, but what if I want to add in another column? I played around without much luck. Would like some help in re-modifying the existing VBA to also look at Type in Column A.

Original code need help with:

Sub Flatten()

    Dim LastR As Long, LastC As Long
    Dim arr As Variant
    Dim RCounter As Long, CCounter As Long
    Dim DestArr() As Variant
    Dim DestRow As Long
    Dim wb As Workbook
    
    With ThisWorkbook.Worksheets("Sheet4") 'rename as needed
        LastR = .Cells(.Rows.Count, "b").End(xlUp).Row
        LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(1, "b"), .Cells(LastR, LastC)).Value
    End With

    ReDim DestArr(1 To (LastR - 1) * (LastC - 2), 1 To 3) As Variant
    
    For CCounter = 2 To (LastC - 1)
        For RCounter = 2 To LastR
            DestRow = DestRow + 1
            DestArr(DestRow, 1) = arr(RCounter, 1)
            DestArr(DestRow, 2) = arr(1, CCounter)
            DestArr(DestRow, 3) = arr(RCounter, CCounter)
        Next
    Next
    
    Set wb = Workbooks.Add
    
    [a1:c1] = Array("Module", "User", "Permission")
    [a2].Resize(UBound(DestArr, 1), UBound(DestArr, 2)).Value = DestArr
    
    wb.SaveAs "c:\Test\Foo.xls", xlExcel12
    wb.Close
    
End Sub

Open in new window

Jacques Geday

you haven't said how you want the data to be laided out ?

MODULE USER PERMISSION ???

OR

TYPE MODULE USER PERMISSION ???
gowflow

Jacques Geday

Is that what you want ??

Sub Flatten4()

    Dim LastR As Long, LastC As Long
    Dim arr As Variant
    Dim RCounter As Long, CCounter As Long
    Dim DestArr() As Variant
    Dim DestRow As Long
    Dim wb As Workbook
    
    With ThisWorkbook.Worksheets("Sheet1") 'rename as needed
        LastR = .Cells(.Rows.Count, "b").End(xlUp).Row
        LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(1, "A"), .Cells(LastR, LastC)).Value
    End With

    ReDim DestArr(1 To (LastR - 1) * (LastC - 2), 1 To 4) As Variant
    
    For CCounter = 2 To (LastC - 1)
        For RCounter = 2 To LastR
            DestRow = DestRow + 1
            DestArr(DestRow, 1) = arr(RCounter, 1)
            DestArr(DestRow, 2) = arr(2, CCounter) '
            DestArr(DestRow, 3) = arr(1, CCounter + 1)
            DestArr(DestRow, 4) = arr(RCounter, CCounter + 1)
        Next
    Next
    
    Set wb = Workbooks.Add
    
    wb.ActiveSheet.Range("a1:d1") = Array("Type", "Module", "User", "Permission")
    wb.ActiveSheet.Range("a2").Resize(UBound(DestArr, 1), UBound(DestArr, 2)).Value = DestArr
    
    wb.SaveAs "c:\Test\Foo.xls", xlExcel12
    wb.Close
    
End Sub

Open in new window

This should give you a display of
Type Module User Permission

Let me know
gowflow

holemania

ASKER

What you provided is working, but not outputting correctly. For the Module column, it seems to work for the first 3, but then it's putting permission after that.

holemania

ASKER

Okay, after playing with it some more, I think I got it to work now.

    For CCounter = 2 To (LastC - 1)
        For RCounter = 2 To LastR
            DestRow = DestRow + 1
            DestArr(DestRow, 1) = arr(RCounter, 1)
            DestArr(DestRow, 2) = arr(RCounter, 2) 
            DestArr(DestRow, 3) = arr(1, CCounter + 1)
            DestArr(DestRow, 4) = arr(RCounter, CCounter + 1)
        Next
    Next

Open in new window

Going to see how it works and will update later.

ASKER CERTIFIED SOLUTION

Jacques Geday

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Jacques Geday

I didn't see that you posted a trial. Yes you got that correct.
gowflow

holemania

ASKER

Thank you goflow.

Jacques Geday

Your welcome glad I could help
gowflow