Solved

VBA - Help with existing flatten file

Posted on 2013-06-25
8
392 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
 

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
convert publisher file to an outlook email template 8 39
highlight duplicate entry 16 30
macro for each dropdown 15 45
DBF to ... Converter 5 43
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

920 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now