Data Layout Conversion (Advanced Rows to Column ?)

Hi,

I have a large CSV (comma delimited) which has data laid out in rows and each row contains about 10,000 separate inputs. This data is an output from a Simulink Simulation where variables have been saved on to the workspace saved as a .mat file then converted into csv (using a tool my colleague wrote). This tool was a modification from a script provided by mathworks therefore quite complex to modify to save the data in the format I need.

Ive attached a spreadsheet with this post which contains the format the data currently is (input) and the format I need it to be in (output). As its an output from simulink some data are multidimensional arrays therefore not all the data can be converted straight from rows to columns. I have used the "Paste Special" and transposed the data for now, but I will need to do this repeatedly therefore looking for a better solution i.e. a vbscript that can do this for me.

Any advice/solution would be appreciated.

Thanks.

Edit: Forgot to mention, the data might always not be in the same format. For e.g. sometimes the data might just be in the following format without any multidimensional arrays..
Header 1
1,2,3,4,5...
Header 2
3,4,5,6,7..
Header 3.. and so on.

Where you have Header 1, Header 2, etc., what do these headers really look like?

These header can be anything as they are whatever I set the Simulink workspace variables as.

Currently they are I_ResolverValidity or I_<xx> for Inputs and O_MonitorFailed or O_<xx> for Outputs. If it helps they can be fully set as a string...

I should have also mentioned the input are all integers. Boolean are represented as 1 & 0s.

I was thinking of character comparison for each row and depending on the character type, decide which row to begin the column from ? That way I could decide if its a header (first row & x column) , array count [0] , [1] ... etc (second row & x column) and finally integer 1,-2,3.. etc to begin from third row and x column. Hope this makes sense.

It makes sense, but I'd like to see some more realistic examples.

I'd like to help you with this but, if I work with what you have provided (even with an explanation), and it doesn't work with your real life data, you're on your own.

I don't want to go through the process twice.

Regards, TMS

Maybe :

Sub Test()
  Dim ws As Worksheet, cell As Range
  Application.ScreenUpdating = False
  ActiveSheet.Copy after:=Sheets(Sheets.Count): Set ws = ActiveSheet
  Columns("A:B").Insert xlShiftToRight
  For Each cell In Intersect(ActiveSheet.UsedRange, Columns("C"))
      If Len(cell) And Not Len(cell.Offset(, 1)) Then
         If Left(cell.Value, 1) = "[" Then
            cell.Cut cell.Offset(1, -1)
         Else
            If Left(cell.Offset(1).Value, 1) = "[" Then cell.Cut cell.Offset(2, -2) Else cell.Cut cell.Offset(1, -2)
         End If
      End If
  Next cell
  Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  Range("A1").CurrentRegion.Copy: Sheets.Add after:=Sheets(Sheets.Count)
  Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
  With Application
    .DisplayAlerts = False: ws.Delete: .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub

Originally Posted by karedog

I have modified my code (correction to one line of code), please check it out. I have test with your sample files at post #1 and #6, and to me, it seem to work very well.

Works with my sample csv as well now. Will use it on the actual data and report back. Quite confident, it'll work.

Cheeers!

Alternative.

This will read the data directly from cvs file.

Sub test()
    Dim fn As String, txt As String, w, x, y
    Dim i As Long, ii As Long, ub As Long, flg As Boolean
    fn = Application.GetOpenFilename("CSVFiles,*.csv")
    If fn = "False" Then Exit Sub
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).REadAll
    x = Split(txt, vbCr): ub = UBound(Split(x(0), ","))
    With CreateObject("VBScript.RegExp")
        For i = 0 To UBound(x)
            y = Split(x(i), ",")
            .Pattern = "^([^,\[]+),+$"
            If .test(x(i)) Then
                If IsEmpty(w) Then
                    ReDim w(1 To ub + 100, 1 To 1)
                Else
                    ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
                End If
                w(1, UBound(w, 2)) = .Execute(x(i))(0).submatches(0): flg = False
            End If
            .Pattern = "^(\[\d+\]).*"
            If .test(x(i)) Then
                If flg Then ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
                w(2, UBound(w, 2)) = .Execute(x(i))(0).submatches(0): flg = True
            End If
            .Pattern = "^(-?\d+(\.\d+)?,?)+.*"
            If .test(x(i)) Then
                For ii = 0 To UBound(y)
                    w(ii + 3, UBound(w, 2)) = y(ii)
                Next
            End If
        Next
    End With
    Sheets("sheet1").Cells(1).Resize(UBound(w, 1), UBound(w, 2)).Value = w
End Sub

I don't know ... you turn your back for 5 minutes

Looks like you are in capable hands so I will bow out gracefully.


Regards, TMS

Always run (new, untested) macros on a copy of your data, not the live file ... or make a backup copy of the live file first.

Option Explicit

Sub Test()
  Dim ws As Worksheet, cell As Range
  Application.ScreenUpdating = False
  ActiveSheet.Copy after:=Sheets(Sheets.Count): Set ws = ActiveSheet
  ' move all the data to the right
  Columns("A:B").Insert xlShiftToRight
  ' check each cell in column C with data
  For Each cell In Intersect(ActiveSheet.UsedRange, Columns("C"))
      ' if the cell is NOT blank and the cell to the right IS blank
      If Len(cell) And Not Len(cell.Offset(, 1)) Then
         ' if the first character in the cell is "[" ...
         If Left(cell.Value, 1) = "[" Then
            ' cut the cell and move it down 1 row, back 1 column
            cell.Cut cell.Offset(1, -1)
         Else
            ' otherwise, if the next cell down first character is "["
            If Left(cell.Offset(1).Value, 1) = "[" Then
                ' cut the cell and put it 2 cells down and 2 columns back
                cell.Cut cell.Offset(2, -2)
            Else
                ' or cut the cell and put it 1 cells down and 2 columns back
                cell.Cut cell.Offset(1, -2)
            End If
         End If
      End If
  Next cell
  ' delete the rows that now have blanks in column C
  Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  ' copy the data; create a new worksheet ... which will become the active sheet
  Range("A1").CurrentRegion.Copy: Sheets.Add after:=Sheets(Sheets.Count)
  ' transpose the restructured data into the new worksheet
  Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
  With Application
    ' delete the original data
    ' I'd probably not do this so that the macro can be re-run
    .DisplayAlerts = False: ws.Delete: .DisplayAlerts = True
    .ScreenUpdating = True
  End With
End Sub

Regards, TMS

You're welcome. Thanks for the rep.