Solved

VBA - Help with existing flatten file

Posted on 2013-06-25
8
397 Views
Last Modified: 2013-06-25
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:
original data
This was my intended output:
final output with current code
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


would like to modify so it also see column A
0
Comment
Question by:holemania
  • 5
  • 3
8 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 39274777
you haven't said how you want the data to be laided out ?

MODULE USER PERMISSION ???

OR

TYPE MODULE USER PERMISSION ???
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39274842
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
0
 

Author Comment

by:holemania
ID: 39275007
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.

Output result
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:holemania
ID: 39275986
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.
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 39275987
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(RCounter, 2) '
            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


gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39275991
I didn't see that you posted a trial. Yes you got that correct.
gowflow
0
 

Author Closing Comment

by:holemania
ID: 39276218
Thank you goflow.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39277141
Your welcome glad I could help
gowflow
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question