Create CSV file based on table in Excel file

[mralmackay]

Hi,

Is it possible to do the following through VBA? If so, would
appreciate your help with this.

I have a table within Excel that contains Roles in Row 1 and
Permissions within Column A. I've then created a matrix of which
permissions link to which roles, this is shown through eiter a number
1 or y in the appropriate cell. See below example of this data:

Accounts Payable System Admin IT User
AccessReportOps 1
AddApprovals 1 y
CatalogManager 1 y

So, using the above example data I'd need a text file to be created
with the following output:
"Accounts Payable","AccessReportOps"
"Accounts Payable","CatalogManager"
"System Admin","AddApprovals"
"IT User","AddApprovals"
"IT User","CatalogManager"

Appreciate your help on this.

Thanks, Al.

 

[Rick Rothstein \(MVP - VB\)]

Give the following macro a try. Set the name of your worksheet in the With
statement (replace my sample Sheet1 name with your worksheet's actual name)
and change my sample file name of "c:\temp\test.txt" in the Open statement
to the path and filename where you want to output your information.

Sub CreateCSV()
Dim X As Long
Dim Y As Long
Dim FF As Long
Dim LastCell As Long
Dim Text As String
With Worksheets("Sheet1")
For X = 2 To 4
LastCell = .Cells(Rows.Count, 1).End(xlUp).Row
For Y = 2 To LastCell
If .Cells(Y, X).Value <> "" Then
Text = Text & """" & .Cells(1, X) & """,""" & _
.Cells(Y, 1).Value & """" & vbNewLine
End If
Next
Next
End With
FF = FreeFile
Open "c:\temp\test.txt" For Output As #FF
Print #FF, Text
Close #FF
End Sub

Rick

 

[mralmackay]

Hi Rick,

Looks good to me so far. Quick query for you.

My data range is bigger than my example before. At present this goes
across 46 columns, how can I expand this to look @ all 46 columns
across?

Thanks in advance, Al.

 

[Rick Rothstein \(MVP - VB\)]

It is usually a bad idea to "simplify" the questions you post to newsgroups
for us. Program solutions, as well as formula solutions, by their very
nature, are customized to the exact question asked (as you can see from my
response) and do not always expand easily to cover the generalize unasked
parts of your question. In this case, you are lucky. I believe modifying the
first For-Next statement is all that is necessary to handle the generalized.
Try the following code, where I assumed you meant by "how can I expand this
to look @ all 46 columns?" that column 46 is your last Roles column (if it
is, in fact, 46 total columns of Roles starting with column 2, then change
the 46 to 47)...

Sub CreateCSV()
Dim X As Long
Dim Y As Long
Dim FF As Long
Dim LastCell As Long
Dim Text As String
With Worksheets("Sheet1")
For X = 2 To 46
LastCell = .Cells(Rows.Count, 1).End(xlUp).Row
For Y = 2 To LastCell
If .Cells(Y, X).Value <> "" Then
Text = Text & """" & .Cells(1, X) & """,""" & _
.Cells(Y, 1).Value & """" & vbNewLine
End If
Next
Next
End With
FF = FreeFile
Open "c:\temp\test.txt" For Output As #FF
Print #FF, Text
Close #FF
End Sub


Hi Rick,

Looks good to me so far. Quick query for you.

My data range is bigger than my example before. At present this goes
across 46 columns, how can I expand this to look @ all 46 columns
across?

Thanks in advance, Al.

 

[Rick Rothstein \(MVP - VB\)]

Let's generalize the code to handle any number of columns for your Roles (in
case it should change in the future)...

Sub CreateCSV()
Dim X As Long
Dim Y As Long
Dim FF As Long
Dim LastCell As Long
Dim LastRole As Long
Dim Text As String
With Worksheets("Sheet1")
LastRole = .Cells(1, Columns.Count).End(xlToLeft).Column
For X = 2 To LastRole
LastCell = .Cells(Rows.Count, 1).End(xlUp).Row
For Y = 2 To LastCell
If .Cells(Y, X).Value <> "" Then
Text = Text & """" & .Cells(1, X) & """,""" & _
.Cells(Y, 1).Value & """" & vbNewLine
End If
Next
Next
End With
FF = FreeFile
Open "c:\temp\test.txt" For Output As #FF
Print #FF, Text
Close #FF
End Sub

Rick

 

[mralmackay]

Brilliant, works a treat.

Thanks Rick, Al.

Let's generalize the code to handle any number of columns for your Roles (in
case it should change in the future)...

Sub CreateCSV()
  Dim X As Long
  Dim Y As Long
  Dim FF As Long
  Dim LastCell As Long
  Dim LastRole As Long
  Dim Text As String
  With Worksheets("Sheet1")
    LastRole = .Cells(1, Columns.Count).End(xlToLeft).Column
    For X = 2 To LastRole
      LastCell = .Cells(Rows.Count, 1).End(xlUp).Row
      For Y = 2 To LastCell
        If .Cells(Y, X).Value <> "" Then
          Text = Text & """" & .Cells(1, X) & """,""" & _
                               .Cells(Y, 1).Value & """" & vbNewLine
        End If
      Next
    Next
  End With
  FF = FreeFile
  Open "c:\temp\test.txt" For Output As #FF
  Print #FF, Text
  Close #FF
End Sub

Rick

message








- Show quoted text -