[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 407
  • Last Modified:

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:
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
holemania
Asked:
holemania
  • 5
  • 3
1 Solution
 
gowflowCommented:
you haven't said how you want the data to be laided out ?

MODULE USER PERMISSION ???

OR

TYPE MODULE USER PERMISSION ???
gowflow
0
 
gowflowCommented:
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
 
holemaniaAuthor Commented:
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
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
holemaniaAuthor Commented:
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
 
gowflowCommented:
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
 
gowflowCommented:
I didn't see that you posted a trial. Yes you got that correct.
gowflow
0
 
holemaniaAuthor Commented:
Thank you goflow.
0
 
gowflowCommented:
Your welcome glad I could help
gowflow
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now