Solved

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

Posted on 2010-09-14
7
604 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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This very simple solution applies to a narrow cross-section of the "needs to close" variety. In this case, the full message in Event Viewer was in applog, Event ID 1000: Faulting application iexplore.exe, version 8.0.6001.18702, faulting module …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

708 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now