Reorganize data within a table/csv file - Excel

Question

I have a .csv file (and many more like it coming) which are not well organized. Here is a sample file

Number,A1Name,A1DoVote,A1Vote,A2Name,A2DoVote,A2Vote,A3Name,A3DoVote,A3Vote,Solution
1,One,true,0,Two,false,50,Three,true,100,50.0
2,One,true,0,Two,false,50,Three,true,100,50.0
3,Two,true,100,One,true,0,Three,false,100,50.0
4,Two,true,100,One,true,0,Three,false,100,50.0
5,Three,true,100,One,true,0,Two,false,50,50.0
6,Three,false,100,One,true,0,Two,true,100,50.0
7,Three,true,100,One,true,0,Two,false,50,50.0
8,Three,false,100,One,true,0,Two,true,100,50.0
9,Two,false,50,Three,true,100,One,true,0,50.0
10,Two,true,100,Three,false,100,One,true,0,50.0
11,Three,true,100,Two,false,50,One,true,0,50.0
12,Three,false,100,Two,true,100,One,true,0,50.0

I imported this in Excel but the problem is that I need the data to be organized by the names so the "One", "Two", "Three" and not be the number of rows. Is there a good way to get the data to always show "One" first, along with the two columns adjacent to it on the right, then "Two", and then "Three" (again with the two adjacent columns? The rows are sets of data so they need to stay that way, I just want the columns to be switched around.

If anything is unclear please comment and I will fix it as fast as possible.

This is what the the above .csv code looks like in Excel

and here is what I would like to have:

As you can see the "One", "Two", and "Three" are all in the same columns and the two right-hand values still adjacent to them. (Wahr is true and falsch is false)

Are you able to show us what result you're looking for in this one example? — Taelsin, Sep 06 '18 at 15:09
Yes that is doable in a several ways. NOTE: There are 3 data items for some of your "categories" vs only two, for instance: One,true,0,50.0 (that is 3 data values you are tying to "one"), rows 9-12, so your two columns to the right won't work in that scenario. I feel like I know what you want but there are several ways to skin the cat on that one. — Wookies-Will-Code, Sep 06 '18 at 15:13
Taelsin: Thank you for pointing out that it is not clear, I edited and showed a "correct" version. Storax: Yes I used the assistant. Wookies-Will-Code: It is always just two values (or three if you count the name), one boolean and an Integer. The 50.0 is the solution and can stay on the right hand side. Thank you all for your comments — NikNet, Sep 06 '18 at 15:23

Tedinoz · Accepted Answer · 2018-09-11T00:16:37.593

You should find that this works. All the ranges, etc are determined dynamically, So this will work with a long data file or a short data file. Data is temporarily copied to the right of the data range (columns M to U), then cut and copied back.

Sub VoteSortbyRow()

Dim lRow As Long, lCol As Long
Dim LR As Long, a1data As Long, a2data As Long, a3data As Long
Dim a1name As Long, a2name As Long, a3name As Long
Dim namecount As Long


    ' assign a value for the number of voyter name columns
    namecount = 3

    ' assign column number for left hand column of the three name ranges
    a1name = 2
    a2name = 5
    a3name = 8

    ' assign column number for left hand column of the three temporary data ranges (out to the right of the data)
    a1data = 13
    a2data = 16
    a3data = 19

    ' get the active sheet name
    MySheet = ActiveSheet.Name

    'Find the last non-blank cell in column B
    LR = Cells(Rows.Count, 2).End(xlUp).Row

    ' Select cell B2
    Cells(2, 2).Select



    For a1loop_ctr = 2 To LR
        'Statements to be executed inside the loop
        ' evaluate column B for value = One, Two or Three; copy data across to respective data ramge on the same row.
        If Cells(a1loop_ctr, a1name) Like "One" Then
            ActiveSheet.Range(Cells(a1loop_ctr, a1name), Cells(a1loop_ctr, (a1name + 2))).Copy Destination:=Cells(a1loop_ctr, a1data)
        ElseIf Cells(a1loop_ctr, a1name) Like "Two" Then
            ActiveSheet.Range(Cells(a1loop_ctr, a1name), Cells(a1loop_ctr, (a1name + 2))).Copy Destination:=Cells(a1loop_ctr, a2data)
        ElseIf Cells(a1loop_ctr, a1name) Like "Three" Then
            ActiveSheet.Range(Cells(a1loop_ctr, a1name), Cells(a1loop_ctr, (a1name + 2))).Copy Destination:=Cells(a1loop_ctr, a3data)
        Else
            'Error message and exist in case the cell is invalid
            MsgBox "VALIDATION ERROR: Cell " & Replace(Replace(Cells(1, a1name).Address, "1", ""), "$", "") & a1loop_ctr & " does not contain a valid voter Name"
            Exit Sub
        End If


    Next a1loop_ctr
    For a2loop_ctr = 2 To LR
        'Statements to be executed inside the loop
        ' evaluate column E for value = One, Two or Three; copy data across to respective data ramge on the same row.
        If Cells(a2loop_ctr, a2name) Like "One" Then
            ActiveSheet.Range(Cells(a2loop_ctr, a2name), Cells(a2loop_ctr, (a2name + 2))).Copy Destination:=Cells(a2loop_ctr, a1data)
        ElseIf Cells(a2loop_ctr, a2name) Like "Two" Then
            ActiveSheet.Range(Cells(a2loop_ctr, a2name), Cells(a2loop_ctr, (a2name + 2))).Copy Destination:=Cells(a2loop_ctr, a2data)
        ElseIf Cells(a2loop_ctr, a2name) Like "Three" Then
            ActiveSheet.Range(Cells(a2loop_ctr, a2name), Cells(a2loop_ctr, (a2name + 2))).Copy Destination:=Cells(a2loop_ctr, a3data)
        Else
            'Error message and exist in case the cell is invalid
            MsgBox "VALIDATION ERROR: Cell " & Replace(Replace(Cells(1, a2name).Address, "1", ""), "$", "") & a2loop_ctr & " does not contain a valid voter Name"
            Exit Sub
        End If


    Next a2loop_ctr
    For a3loop_ctr = 2 To LR
        'Statements to be executed inside the loop
        ' evaluate column H for value = One, Two or Three; copy data across to respective data ramge on the same row.
        If Cells(a3loop_ctr, a3name) Like "One" Then
            ActiveSheet.Range(Cells(a3loop_ctr, a3name), Cells(a3loop_ctr, (a3name + 2))).Copy Destination:=Cells(a3loop_ctr, a1data)
        ElseIf Cells(a3loop_ctr, a3name) Like "Two" Then
            ActiveSheet.Range(Cells(a3loop_ctr, a3name), Cells(a3loop_ctr, (a3name + 2))).Copy Destination:=Cells(a3loop_ctr, a2data)
        ElseIf Cells(a3loop_ctr, a3name) Like "Three" Then
            ActiveSheet.Range(Cells(a3loop_ctr, a3name), Cells(a3loop_ctr, (a3name + 2))).Copy Destination:=Cells(a3loop_ctr, a3data)
        Else
            'Error message and exist in case the cell is invalid
            MsgBox "VALIDATION ERROR: Cell " & Replace(Replace(Cells(1, a3name).Address, "1", ""), "$", "") & a3loop_ctr & " does not contain a valid voter Name"
            Exit Sub
        End If


    Next a3loop_ctr

    ' cut the data for One and paste it to column B
    ActiveSheet.Range(Cells(2, a1data), Cells(LR, a1data + 2)).Cut Destination:=Cells(2, a1name)

    ' cut the data for TWO and paste it to column E
    ActiveSheet.Range(Cells(2, a2data), Cells(LR, a2data + 2)).Cut Destination:=Cells(2, a2name)

    ' cut the data for THREE and paste it to column H
    ActiveSheet.Range(Cells(2, a3data), Cells(LR, a3data + 2)).Cut Destination:=Cells(2, a3name)

    ' Select cell B2
    Cells(2, 2).Select
End Sub

How to add one extra voter

Update namecount to 4
Add a variable 'a4name' and give it a value of 11
Create a new variable 'a4data'
Set 'a1data' to a column number value anywhere to the right of the main data range. Then set a2data=a1datat+3, a3data=a2data+3, a4data=a3data+3.
Add an a4loop based on the pattern from a1loop, a2loop, etc.

Follow the same approach if a 5th, 6th and so voter is added.

If you have a lot of files, then you might find this macro handy also. It lets you browse for a csv file, opens the file, inserts the data into your worksheet, and renames the sheet to the file name.

Sub ImportCSVVoting()

Dim vPath As Variant
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = Excel.ActiveSheet

vPath = Application.GetOpenFilename("CSV (Comma Delimited) (*.csv),*.csv" _
, 1, "Select a file", , False)
''//Show the file open dialog to allow user to select a CSV file

If vPath = False Then Exit Sub
''//Exit macro if no file selected

Workbooks.OpenText Filename:=vPath, Origin:=xlMSDOS, StartRow:=1 _
    , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True _
    , FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), _
    Array(3, xlTextFormat))
''//The fieldinfo array needs to be extended to match your number of columns

Columns.EntireColumn.AutoFit
''//Resize the columns

Sheets(1).Move Before:=wb.Sheets(1)
''//Move the data into the Workbook

Cells(1, 1).Select
''// Select cell A1

End Sub

Hey Tedinoz, thank you so much for your reply, this actually seems like a very good solution, especially as I might also be working with votes of a fourth person. I ran the code and it seemed to work perfectly at first, I then realized that it actually alters the data a little bit. With the posted example it results in a row where DoVote are true for all, A1, A2, and A3. Which does not exist in the original data. One row is always one dataset and should stay together. Do you know a fix for this? — NikNet, Sep 07 '18 at 07:31
Oh, my apologies. The penny has just dropped. I see exactly what you mean. Give me a moment or two. — Tedinoz, Sep 07 '18 at 11:27
Okay. I've updated to sort by row rather than by column. Results look correct to me. **Just to stress**: the data is temporarily copied to columns M to U, and then cut and pasted back to the initial data range. But this assumes that those columns (M to U) are not being used. If you are using them, let me know and we'll modify the code. — Tedinoz, Sep 07 '18 at 13:03
Thank you, this works perfectly and helps me greatly! With 4 Agents the Table would go into M, where would I change to code to make the temporary space be say P to X? — NikNet, Sep 07 '18 at 13:09
1= Update namecount to 4; 2 = add a variable 'a4name' and give it a value of 11; 3=create a new variable 'a4data'; 4=set 'a1data' to a column number value anywhere to the right of the main data range. Then set a2data=a1datat+3, a3data=a2data+3, a4data=a3data+3. Now that I think about it, I could have coded the vba like this, and you'd only have to set the first column, and the others would just follow. Ditto a1name, etc. — Tedinoz, Sep 07 '18 at 13:21
Sorry. Got a bit carried away there. Yes, P to X would be fine. — Tedinoz, Sep 07 '18 at 21:24
Just for the ones stumbling on this thread later on, for 4 or more agents there also need to be an a4loop... added, this is easy to do with looking at the pattern from 1, 2, and 3. I an absolute beginner at vba and it was absolutely doable. Thank you @Tedinoz for this solution, which I ended up using! — NikNet, Sep 09 '18 at 09:22
@NikNet I looked at making the VBA more efficient (and got a reasonable outcome), but the uncertainty of the number of voters remains. Adding a new voter as described in the comments (and I will update Answer) seems like the best approach for the time being. — Tedinoz, Sep 11 '18 at 00:04

Orin · Answer 2 · 2018-09-10T16:25:43.753

If you haven't split the cells up yet, With the cells selected run this macro... I copied and pasted what you had and worked with that.

There are some other ways of doing this if you already imported them into excel as a CSV and split the values into their own columns already. Does this help? There are really a ton of approaches in VBA to a problem like this.

Sub SplitOneTwoThree()
    Dim Arr1 As Variant
    Dim I as long
    Dim K As long

    For I = 1 To Selection.Rows.Count
        Arr1 = Split(ActiveCell.Offset(I - 1, 0).Value, ",")
        For K = 1 To UBound(Arr1)
            If Arr1(K) = "One" Then
                ActiveCell.Offset(I - 1, 1) = Arr1(K)
                ActiveCell.Offset(I - 1, 2) = Arr1(K + 1)
                ActiveCell.Offset(I - 1, 3) = Arr1(K + 2)
                K = K + 2
            End If
            If Arr1(K) = "Two" Then
                ActiveCell.Offset(I - 1, 4) = Arr1(K)
                ActiveCell.Offset(I - 1, 5) = Arr1(K + 1)
                ActiveCell.Offset(I - 1, 6) = Arr1(K + 2)
                K = K + 2
            End If
            If Arr1(K) = "Three" Then
                ActiveCell.Offset(I - 1, 7) = Arr1(K)
                ActiveCell.Offset(I - 1, 8) = Arr1(K + 1)
                ActiveCell.Offset(I - 1, 9) = Arr1(K + 2)
                K = K + 2
            End If
        Next K
    Next I
End Sub

Note that `Dim I, K As Integer` only defines `K As Integer` but `I As Variant` in VBA you need to specify a type for **every** variable. Also you must use `Long` for row counting variables because Excel has more rows than `Integer` can handle: `Dim I As Long, K As Long` • It is recommended [always to use Long instead of Integer](https://stackoverflow.com/a/26409520/3219613) as there is no benefit in using `Integer` in VBA. — Pᴇʜ, Sep 07 '18 at 06:40
Hey Orin, thank you very much for your answer! I can't really get it to work, what do you mean by having split up the cells? I might just be selecting the wrong cells or making some other basic mistake. — NikNet, Sep 07 '18 at 07:26
@Peh Thank you! Niknet When you import the CSV you can run it through an import process which splits the cells by the delimiter (Comma). I wasn't sure if you were doing that. Looks like you've already got a more refined solution anyway. :) — Orin, Sep 10 '18 at 16:31

score 0 · Answer 3 · answered Sep 06 '18 at 18:29

0

The code below is not pretty, but it will accomplish what your asking for, to include the Solution values. Change "Sheet1" to the sheet where your data is located.

Set ws = Worksheets("Sheet1")
lRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = ws.Range("B2:B" & lRow)
Dim x As Long
Dim i As Long

For i = 1 To 2
    For x = 2 To lRow
        If Cells(x, "B").Value <> "One" Then
            Cells(x, "B").Resize(, 3).Copy
            Cells(x, "B").Offset(, 9).Insert Shift:=xlToRight
            Cells(x, "B").Resize(, 3).Delete Shift:=xlToLeft
        End If
    Next
Next i

For x = 2 To lRow
    If Cells(x, "E").Value <> "Two" Then
        Cells(x, "E").Resize(, 3).Copy
        Cells(x, "E").Offset(, 6).Insert Shift:=xlToRight
        Cells(x, "E").Resize(, 3).Delete Shift:=xlToLeft
    End If
Next

answered Sep 06 '18 at 18:29

GMalc

2,608
1
9
16

Hey, this somehow gives me a runtime error '1004', I might just not be using it right, could you briefly explain how to run it? – NikNet Sep 07 '18 at 07:35
It is based off the picture of the .cvs data in your question. Your before picture shows the text is already separated into columns and rows. To test this code i copied your sample data from your question and pasted (keep source formatting) it in a new workbook. Then ran a `TextToColumns` sub to get it to match your before picture. I then ran this Sub to rearrange the data to your request. – GMalc Sep 07 '18 at 13:30
The code works on .csv data already imported into excel after TextToColumns has been accomplished. Like your before picture, without the Filter. – GMalc Sep 07 '18 at 13:41

Reorganize data within a table/csv file - Excel

3 Answers3