Macro or VBA to split out rows and divide data

[charleymax]

Hi all,

I want to write a quick macro to run when required... I want it to take a sheet I have in another spreadsheet and take each line where say column C has data in it and copy it once to the new sheet if the cell in column A is either blank or contains a single number without commas. If the cell in column A has 2 numbers seperated by a comma i.e. 16, 17 I need it to copy the row twice and split a value in another column (say column D) between the new rows. So A has "14, 15" and D has "2"... I need 2 new rows with 14 in A for one and 15 in A for the next and for each to have 1 (half of the original 2) in col D....

 

[hiker95]

charleymax,

You are posting a picture. This means that if this was a problem where one needed to use your data, anyone trying to help you would have to enter the data manually. That makes no sense and I doubt that you would get any answer.


What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples directly in the forum.

Please attach screenshots of your workbook or a sample workbook that accurately portrays your current workbook on one sheet, and what it should look like 'After' on another sheet.

This makes it much easier to see exactly what you want to do, as well as shows us whether there is a consistent number of rows between tables and such.

Here are three possible ways to post small (copyable) screen shots directly in your post:

Please post a screenshot of your sheet(s), what you have and what you expect to achieve, with Excel Jeanie HTML 4 (contains graphic instructions).
http://www.excel-jeanie-html.de/html/hlp_schnell_en.php

or
RichardSchollar’s beta HTML Maker -...his signature block at the bottom of his post

or
Borders-Copy-Paste



If you are not able to give us screenshots:

To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

You can upload your workbook to www.box.net and provide us with a link to your workbook.

 

[MrKowz]

Give this a shot. It is untested, so if it doesn't work, please report back what didn't work and I will fix it.

Public Sub SplitColA()
Dim i   As Long, _
    j   As Long, _
    LR  As Long, _
    tmp As Variant
    
LR = Range("A" & rows.Count).End(xlUp).row
Application.ScreenUpdating = False
For i = LR To 1 Step -1
    If InStr(Range("A" & i).Value, ",") > 0 Then
        tmp = Split(Range("A" & i).Value, ",")
        For j = UBound(tmp) To LBound(tmp) + 1 Step -1
            Range("A" & i).Offset(1, 0).Insert Shift:=xlDown
            rows(i).Copy Destination:=rows(i + 1)
            Range("A" & i).Offset(1, 0).Value = tmp(j)
            Range(Range("T" & i), Range("T" & i).Offset(1, 0)).Value = Range("T" & i).Value / 2
        Next j
    End If
Next i
Application.ScreenUpdating = True
End Sub

 

[charleymax]

Apologies Hiker95

here is the file...
http://www.box.net/shared/q2a6i2g4pn

 

[charleymax]

Give this a shot. It is untested, so if it doesn't work, please report back what didn't work and I will fix it.

Hi MrKowz

This is part of the way there... it creates the new entries for after the comas... but it's not copying down all the row so there ends up being a disjoin between col A and the rest of what should be the rows...
I end up with the longer Col A but the rest of the sheet stays the same.
Also it doesnt then trim of the extra numbers from the original entry....

I've attached a link to a sheet above which shows 2 sheets showing before and after data...

Finally I don't want this to change the "Live" data, so would prefer it to copy over the whole sheet to another workbook and then run this code on it...

bit of a tall order I know...

 

[MrKowz]

Sadly, my workplace restricts me from downloading files (as is the case with many of the helpers here). I've tested this on some dummy data.

Option Explicit
Public Sub SplitColA()
Dim i   As Long, _
    j   As Long, _
    LR  As Long, _
    LR2 As Long, _
    tmp As Variant, _
    sWS As Worksheet, _
    dWS As Worksheet
    
Set sWS = ActiveSheet
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Split Data"
Set dWS = Sheets("Split Data")
    
LR = sWS.Range("A" & rows.Count).End(xlUp).row
Application.ScreenUpdating = False
For i = 1 To LR
    If InStr(sWS.Range("A" & i).Value, ", ") > 0 Then
        tmp = Split(sWS.Range("A" & i).Value, ", ")
        For j = LBound(tmp) To UBound(tmp)
            LR2 = dWS.Range("A" & rows.Count).End(xlUp).row + 1
            sWS.rows(i).Copy Destination:=dWS.Range("A" & LR2)
            dWS.Range("A" & LR2).Value = tmp(j)
            dWS.Range("T" & LR2).Value = dWS.Range("T" & LR2).Value / (UBound(tmp) + 1)
        Next j
    Else
        LR2 = dWS.Range("A" & rows.Count).End(xlUp).row + 1
        sWS.rows(i).Copy Destination:=dWS.Range("A" & LR2)
    End If
Next i
dWS.rows(1).Delete shift:=xlUp
Application.ScreenUpdating = True
End Sub

 

[charleymax]

Sadly, my workplace restricts me from downloading files (as is the case with many of the helpers here). I've tested this on some dummy data.

Brilliant!!! This is exactly what I want and works great on my test sheet... Just need to integrate it to the live data now!


Many many thanks!