Solved

Parse CSV contents in multiple columns and copy into multiple rows accordingly.

Posted on 2010-09-14
7
630 Views
Last Modified: 2012-06-27
Hello There,
I've found some good starting points to my problem, but I've yet to find a complete solution for what I'm trying to do.  This solution seems to come close (I'm not sure if I can post links):

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_24946323.html?sfQueryTermInfo=1+10+30+cell+multipl+row+split+valu

As shown in the attached example, I need to take it one step further.  I have a schedule that is basically a spreadsheet of dates, with project names as my left column and schedule items as my header.  I do some simple cell formatting and save the file as a CSV (all done in VBA) in order to import it into a MySQL database.  Every schedule item column is followed by an 'actualized' column, to show if the schedule item occurred as specified.  It's not common, but in some cases we'll need to schedule a second 'Meeting 2' or 'Submit Draft' which means one cell now has two dates (return delimited, ASCI 0010).  For each date and corresponding 'A' (actualized status), I need to parse cells with multiple values into single rows.  If it's any help, the person that updates our schedule is very consistent in accounting for schedule items with 2 or 3 dates, so any actualized column that follows a cell with multiple dates will have a matching number of 'A's and/or returns.

I'm not even sure if there is a slam-bang solution to this problem, since the macro would have to parse cells consistently across multiple columns, and not just parse all cells with multiple delimited values.  I hope this makes some sense, and I would GREATLY appreciate any and all help.

Thanks a ton!  Not to butter you up or anything . . . but you are some kind of genius if you can figure this out.
     Example---Before--After.xlsx
0
Comment
Question by:cobujo3
  • 3
  • 2
  • 2
7 Comments
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 33680408
The below code will do what you ask (tested against your example, but should also work for cells containing more than two rows).

You just need to change the source sheet in the SplitToSingleRows macro:

Set wsSource = ThisWorkbook.Sheets("Before")

When run, a new sheet is created with all the multiple row cells split into single rows.

Private wsSplit As Worksheet

Public Sub SplitToSingleRows()
   Dim wsSource As Worksheet
   Set wsSource = ThisWorkbook.Sheets("Before")
   wsSource.Copy After:=wsSource
   Set wsSplit = ActiveSheet
   
   SplitByColumn 2
   SplitByColumn 4
   SplitByColumn 6
   SplitByColumn 8
End Sub


Private Sub SplitByColumn(iColumn As Integer)
   Dim i As Integer
   Dim iLastRow As Integer
   Dim sCellValue As String
   
   iLastRow = wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Row
   i = 2 ' Start from row 2, missing headers
   While i <= iLastRow
      sCellValue = wsSplit.Cells(i, iColumn).Value
      If InStr(1, sCellValue, vbLf) > 0 Then
         ' This row needs to be split
         SplitRow i
         iLastRow = iLastRow + 1
      End If
      i = i + 1
   Wend
End Sub

Private Sub SplitRow(iRow As Integer)
   Dim i As Integer
   Dim sCellValue As String
   Dim iSplitPos As Integer
   
   With wsSplit
      .Rows(iRow).Insert
      For i = 1 To wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Column
         sCellValue = wsSplit.Cells(iRow + 1, i).Value
         iSplitPos = InStr(1, sCellValue, vbLf)
         If iSplitPos > 0 Then
            ' Split this cell
            wsSplit.Cells(iRow, i).Value = Left(sCellValue, iSplitPos - 1)
            wsSplit.Cells(iRow + 1, i).Value = Mid(sCellValue, iSplitPos + 1)
         Else
            wsSplit.Cells(iRow, i).Value = sCellValue
         End If
      Next
   End With
End Sub

Open in new window

0
 
LVL 24

Accepted Solution

by:
purplepomegranite earned 500 total points
ID: 33680440
Sorry, ignore the code above.  I hadn't actually compared to your After sheet, which was a little shortsighted of me!!

The code below does generate the sheet correctly.

Private wsSplit As Worksheet

Public Sub SplitToSingleRows()
   Dim wsSource As Worksheet
   Set wsSource = ThisWorkbook.Sheets("Before")
   wsSource.Copy After:=wsSource
   Set wsSplit = ActiveSheet
   
   SplitByColumn 2
   SplitByColumn 4
   SplitByColumn 6
   SplitByColumn 8
End Sub


Private Sub SplitByColumn(icolumn As Integer)
   Dim i As Integer
   Dim iLastRow As Integer
   Dim sCellValue As String
   
   iLastRow = wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Row
   i = 2 ' Start from row 2, missing headers
   While i <= iLastRow
      sCellValue = wsSplit.Cells(i, icolumn).Value
      If InStr(1, sCellValue, vbLf) > 0 Then
         ' This row needs to be split
         SplitRow i, icolumn
         iLastRow = iLastRow + 1
      End If
      i = i + 1
   Wend
End Sub

Private Sub SplitRow(iRow As Integer, icolumn As Integer)
   Dim i As Integer
   Dim sCellValue As String
   Dim iSplitPos As Integer
   
   With wsSplit
      .Rows(iRow).Insert
      For i = 1 To wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Column
         sCellValue = wsSplit.Cells(iRow + 1, i).Value
         If (i = icolumn) Or (i = icolumn + 1) Then
            iSplitPos = InStr(1, sCellValue, vbLf)
            If iSplitPos > 0 Then
               ' Split this cell
               wsSplit.Cells(iRow, i).Value = Left(sCellValue, iSplitPos - 1)
               wsSplit.Cells(iRow + 1, i).Value = Mid(sCellValue, iSplitPos + 1)
            End If
         Else
            wsSplit.Cells(iRow, i).Value = sCellValue
         End If
      Next
   End With
End Sub

Open in new window

0
 
LVL 4

Expert Comment

by:rowanscott
ID: 33710315
Hi I have attached asmple using classes making it quite versatile.  It works for your before and after sample OK but i would like to add a few more things to make it cope with abnormalities if you want to use this code.

Not sure if its formating on my computer or not but there was differnce in date formatting on the two sheets. dd/mm/yyyy and mm/dd/yyyy. It should not be too hard to create some control for this too.

If you copy and paste the code notice there is one module and three class modules to import.

Best regards

Rowan
Copy-of-Example---Before--After.xlsm
0
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 
LVL 4

Expert Comment

by:rowanscott
ID: 33710363
I forgot to mention.  Run the macro called Test

It opens notepad witht the csv string.
0
 

Author Comment

by:cobujo3
ID: 33728258
Pomegranite,

  First off, sorry for the very late reply.  I haven't had the time to really test this out, but I think the solution you propose is what I'm looking for--thank you!  The before and after example that I initially submitted, as you might guess, isn't the entire worksheet that I'm trying to format.  I am wanting to search a lot of column in my worksheet for multiple entries and split accordingly.  Below is the macro that I have edited--it's basically the code you submitted except I've added a lot more SplitByColumn integers:

I tried splitting by only one column (18) and it worked fine.  However, once I try to split by more than 1 column, I get a type mismatch error.  Does this have to do with the destination worksheet for the newly formatted data?  It really doesn't matter for my purposes how this is done, whether the formatted data replaces the old data in the existing worksheet or if there is one new worksheet after all columns have been split.

I hope this makes sense, and this very well might be a simple fix that I'm just not seeing.

Thanks
Private wsSplit As Worksheet

Public Sub LSP_split()
   Dim wsSource As Worksheet
   Set wsSource = ActiveSheet
   wsSource.Copy After:=wsSource
   Set wsSplit = ActiveSheet
   
   SplitByColumn 18
   SplitByColumn 20
   SplitByColumn 24
   SplitByColumn 26
   SplitByColumn 28
   SplitByColumn 32
   SplitByColumn 34
   SplitByColumn 36
   SplitByColumn 38
   SplitByColumn 40
   SplitByColumn 42
   SplitByColumn 44
   SplitByColumn 46
   SplitByColumn 48
   SplitByColumn 50
   SplitByColumn 52
   SplitByColumn 54
   SplitByColumn 56
   SplitByColumn 58
   SplitByColumn 60
   SplitByColumn 63
   SplitByColumn 65
   SplitByColumn 67
   SplitByColumn 71
   SplitByColumn 72
   SplitByColumn 74
   SplitByColumn 77
   SplitByColumn 79
End Sub


Private Sub SplitByColumn(iColumn As Integer)
   Dim i As Integer
   Dim iLastRow As Integer
   Dim sCellValue As String
   
   iLastRow = wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Row
   i = 2 ' Start from row 2, missing headers
   While i <= iLastRow
      sCellValue = wsSplit.Cells(i, iColumn).Value
      If InStr(1, sCellValue, vbLf) > 0 Then
         ' This row needs to be split
         SplitRow i
         iLastRow = iLastRow + 1
      End If
      i = i + 1
   Wend
End Sub

Private Sub SplitRow(iRow As Integer)
   Dim i As Integer
   Dim sCellValue As String
   Dim iSplitPos As Integer
   
   With wsSplit
      .Rows(iRow).Insert
      For i = 1 To wsSplit.Cells.SpecialCells(xlCellTypeLastCell).Column
         sCellValue = wsSplit.Cells(iRow + 1, i).Value
         iSplitPos = InStr(1, sCellValue, vbLf)
         If iSplitPos > 0 Then
            ' Split this cell
            wsSplit.Cells(iRow, i).Value = Left(sCellValue, iSplitPos - 1)
            wsSplit.Cells(iRow + 1, i).Value = Mid(sCellValue, iSplitPos + 1)
         Else
            wsSplit.Cells(iRow, i).Value = sCellValue
         End If
      Next
   End With
End Sub

Open in new window

0
 

Author Comment

by:cobujo3
ID: 33730675
Pomegranite,

  IGNORE MY PREVIOUS COMMENT.  For some reason, the macro was stopping at any cell that had a formula error (#VALUE!, #REF!, #NUM!).  I don't need these values, so I did a find and replace for all of these, and now IT WORKS!

  I apologize again for the late reply.  You, sir, are a VBA genius.  This code is a huge help, and I'm planning to make a contribution to your website in the near future.  Thanks a ton!
0
 

Author Closing Comment

by:cobujo3
ID: 33730678
Awesome .
0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question