Convert and Split Data

Manxie

New member
Joined
Oct 25, 2012
Messages
4
Reaction score
0
Points
0
Hello I am new this forum so I hope I am posting in the right place.


I need to alter the way information in presented in a spreadsheet. I have attached a sample spreadsheet which hopefully illustrates
what is required.
Row 1 contains field names and row 2 the relevant data for a make and model of motor car. However I need this information presented
as single records for each product choice.
Rows 4 to 12 illustrate what I need.


This is a task that needs doing regularly so I need a method that can automate this for 4000 product lines.


Thanks in advance.
 

Attachments

  • Test Data Conversion.xls
    15 KB · Views: 21
A couple of questions for you...

I assume that you have multiple makes and models in your original table, and that you're trying to create one really long list in the format that you showed? So next car just bumped right up against the details for the other? (Looks like your trying to get the data in a compliant source for a PivotTable.)

I also assume that the 1 Series, 2 Series and 3 Series were all supposed to be 1 Series E 81?

When you say 4000 product lines, will you be getting all 4000 at one time and needing to create that list?

I'm thinking that you're probably going to need a VBA solution for this, but just want to check on those details first.
 
Hi
Yes there are all makes a models listed and yes I need one really long list to upload as a csv to an ecommerce website. I had this exact task done for me but I would like to be in a position to do it for myself.
Yes the next car model is under the previous and it just runs alphabetically a-z.

Sorry about the 1 Series - you are right in your assumptions.

Including commercial vehicles there are over 6000 vehicle listings.

Thank you so much for your help.


A couple of questions for you...

I assume that you have multiple makes and models in your original table, and that you're trying to create one really long list in the format that you showed? So next car just bumped right up against the details for the other? (Looks like your trying to get the data in a compliant source for a PivotTable.)

I also assume that the 1 Series, 2 Series and 3 Series were all supposed to be 1 Series E 81?

When you say 4000 product lines, will you be getting all 4000 at one time and needing to create that list?

I'm thinking that you're probably going to need a VBA solution for this, but just want to check on those details first.
 
Alright, so here's what you need to know...

  • You can't have anything underneath your data table.
  • The data table starts in row 1
  • There is no blank row between the data table and the data
I dont' think any of that is abnormal though, as that's the way you gave me your sample file. I did move your "output" format out of the way to make sure we met rule 1.

Now, you need to add some VBA code to automate this so... in your workbook with the data...
  • Press Alt+F11 to open the Visual Basic Editor
  • Find your project at left and expand it
  • Right click Microsoft Excel Objects
  • Choose Insert->Module
  • In the pane that opens, paste the following:

Code:
Option Explicit
Option Base 1
Sub CreateUploadList()
    Dim aryExamine() As Variant
    Dim aryCategory() As Variant
    Dim aryPlace(1, 5) As String
    Dim lCol As Long
    Dim wsTarget As Worksheet
    Dim wsSource As Worksheet
    Dim lRow As Long
    Dim lRowEnd As Long
    Dim lPasteRow As Long
    
    'Set base variables
    Set wsSource = ActiveSheet
    lPasteRow = 1
    
    'Set up sheet to hold data
    On Error Resume Next
    Set wsTarget = Worksheets("UploadFormat")
    If Err.Number <> 0 Then
        Set wsTarget = Worksheets.Add
        wsTarget.Name = "UploadFormat"
    Else
        wsTarget.Cells.ClearContents
    End If
    On Error GoTo 0
    wsTarget.Range("A1:E1").Value = Array("MAKE", "MODEL", "YEAR", "DESCRIPTION", "REF")
    
    'Collect info
    With wsSource
        lRowEnd = .Range("A" & .Rows.Count).End(xlUp).Row
        If lRowEnd = 1 Then
            MsgBox "Sorry, no data to examine!"
            Exit Sub
        End If
        
        'Collect category info
        aryCategory = .Range("E1:M1").Value
        
        For lRow = 2 To lRowEnd
            'Get details on record to format
            aryExamine = .Range("A" & lRow & ":M" & lRow).Value
            
            'Build constant portion of record
            For lCol = 1 To 3
                aryPlace(1, lCol) = aryExamine(1, lCol)
            Next lCol
        
            'Modify variable portion and place in target worksheet
            For lCol = 5 To 13
                If IsEmpty(aryExamine(1, lCol)) Then
                    'Ignore this record as it is empty
                Else
                    'Record description and ref
                    aryPlace(1, 4) = aryCategory(1, lCol - 4)
                    aryPlace(1, 5) = aryExamine(1, lCol)
                    
                    'Paste
                    lPasteRow = lPasteRow + 1
                    wsTarget.Range("A" & lPasteRow).Resize(1, 5) = aryPlace
                End If
            Next lCol
        Next lRow
    End With
End Sub


  • Close the Visual Basic Editor
  • Make sure you are on the sheet with the data table
  • Save the file
  • Press Alt+F8
  • Double click CreateUploadList

That should be all it takes. Let me know if the output is correct.
 
Hi Ken
firstly let me apologise for not replying to you sooner. I really am so very pleased with what you have done which works great on the little sample data file but for some reason I am getting an error when I try to run your script on the big spreadsheet which i have copied below. the error is highlighted as being aryPlace(1, 5) = aryExamine(1, lCol).

I hope this makes sense


Thanks


Code:
Option ExplicitOption Base 1
Sub CreateUploadList()
    Dim aryExamine() As Variant
    Dim aryCategory() As Variant
    Dim aryPlace(1, 5) As String
    Dim lCol As Long
    Dim wsTarget As Worksheet
    Dim wsSource As Worksheet
    Dim lRow As Long
    Dim lRowEnd As Long
    Dim lPasteRow As Long
    
    'Set base variables
    Set wsSource = ActiveSheet
    lPasteRow = 1
    
    'Set up sheet to hold data
    On Error Resume Next
    Set wsTarget = Worksheets("UploadFormat")
    If Err.Number <> 0 Then
        Set wsTarget = Worksheets.Add
        wsTarget.Name = "UploadFormat"
    Else
        wsTarget.Cells.ClearContents
    End If
    On Error GoTo 0
    wsTarget.Range("A1:E1").Value = Array("MAKE", "MODEL", "YEAR", "DESCRIPTION", "REF")
    
    'Collect info
    With wsSource
        lRowEnd = .Range("A" & .Rows.Count).End(xlUp).Row
        If lRowEnd = 1 Then
            MsgBox "Sorry, no data to examine!"
            Exit Sub
        End If
        
        'Collect category info
        aryCategory = .Range("E1:M1").Value
        
        For lRow = 2 To lRowEnd
            'Get details on record to format
            aryExamine = .Range("A" & lRow & ":M" & lRow).Value
            
            'Build constant portion of record
            For lCol = 1 To 3
                aryPlace(1, lCol) = aryExamine(1, lCol)
            Next lCol
        
            'Modify variable portion and place in target worksheet
            For lCol = 5 To 13
                If IsEmpty(aryExamine(1, lCol)) Then
                    'Ignore this record as it is empty
                Else
                    'Record description and ref
                    aryPlace(1, 4) = aryCategory(1, lCol - 4)
[B]                    aryPlace(1, 5) = aryExamine(1, lCol)[/B]
                    
                    'Paste
                    lPasteRow = lPasteRow + 1
                    wsTarget.Range("A" & lPasteRow).Resize(1, 5) = aryPlace
                End If
            Next lCol
        Next lRow
    End With
End Sub
 
Here is a larger sample of the raw data.
Thanks
 

Attachments

  • Excel-Guru-Sample.xls
    26.5 KB · Views: 8
Hi there,

I didn't realize that the source data would contain #N/A errors. We can deal with those be changing:
Code:
                        aryPlace(1, 5) = aryExamine(1, lCol)

To this:
Code:
                    If CStr(aryExamine(1, lCol)) = "Error 2042" Then
                        aryPlace(1, 5) = "#N/A"
                    Else
                        aryPlace(1, 5) = aryExamine(1, lCol)
                    End If

In addition, though, I also notice that your data is in Column B here, where I built it starting in Column A. Did you work around that issue?
 
Back
Top