Background: I have a bunch of data that I need to transform, and I was hoping you all could help me automate this process as much as possible.
Data: ~20 Excel workbooks with two tabs: (edges) = an adjacency matrix and (vertices) = attributes about those vertices from the matrix.
Goal: Run a VBA script on each workbook that does two things: (1) converts the matrix to a weighted edgelist and save output as a new CSV, (2) find-and-replace attribute values in the vertices tab and save output as a new CSV.
Challenge: I was able to easily write the code to do the second part, and I was able to find and adapt some code to do the first part, but my challenge is that I don't know how redirect the output of these two separate macros to two separate CSV files. I would also like to save these files if possible. Even further, if I could somehow append "_edges.csv" and "_vertices.csv" to the file names, that would be awesome. Otherwise, saving each one as just "edges.csv" and "vertices.csv" will be fine, as each persons data will be held in their own folder. Also, if there is some way to filter out relationships without a weight (blank) in the edgelist CSV, that would be amazing!!
I've attached a workbook with sample data as well as my existing code.
Thank you for your help!
JohnA..xlsm
Code:
Sub color()
'find and replace color name with RGB value
Columns("B:B").Replace What:="yellow", Replacement:="246, 241, 144", LookAt:=xlPart, MatchCase:=False
Columns("B:B").Replace What:="orange", Replacement:="248, 185, 116", LookAt:=xlPart, MatchCase:=False
Columns("B:B").Replace What:="red", Replacement:="240, 128, 100", LookAt:=xlPart, MatchCase:=False
Columns("B:B").Replace What:="purple", Replacement:="175, 118, 176", LookAt:=xlPart, MatchCase:=False
Columns("B:B").Replace What:="blue", Replacement:="121, 157, 209", LookAt:=xlPart, MatchCase:=False
Columns("B:B").Replace What:="green", Replacement:="124, 172, 126", LookAt:=xlPart, MatchCase:=False
Columns("B:B").Replace What:="ego", Replacement:="176, 176, 176", LookAt:=xlPart, MatchCase:=False
'format as comma seperated value
Columns("B:B").Select
Selection.NumberFormat = "###,###,###"
End Sub
Sub matrix2edgeList()
Dim SummaryTable As Range, OutputRange As Range
Dim OutRow As Long
Dim r As Long, c As Long
On Error Resume Next
Set SummaryTable = ActiveCell.CurrentRegion
If SummaryTable.Count = 1 Or SummaryTable.Rows.Count < 3 Then
MsgBox "Select a cell within the summary table.", vbCritical
Exit Sub
End If
SummaryTable.Select
Set OutputRange = Application.InputBox(prompt:="Select a cell for the 3-column output", Type:=8)
' Convert the range
OutRow = 2
Application.ScreenUpdating = False
OutputRange.Range("A1:C3") = Array("Source", "Target", "Weight")
For r = 2 To SummaryTable.Rows.Count
For c = 2 To SummaryTable.Columns.Count
OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c)
OutputRange.Cells(OutRow, 3) = SummaryTable.Cells(r, c)
OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
OutRow = OutRow + 1
Next c
Next r
End Sub
Bookmarks