Solved

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

Posted on 2010-09-14
7
668 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Database Solutions Engineer FAQs

In this series, we will discuss common questions received as a database Solutions Engineer at Percona. In this role, we speak with a wide array of MySQL and MongoDB users responsible for both extremely large and complex environments to smaller single-server environments.

 
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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

This article describes a serious pitfall that can happen when deleting shapes using VBA.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

627 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