Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

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

Posted on 2010-09-14
7
Medium Priority
?
684 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 2000 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
Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

 
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

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

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

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

885 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