Macro or VBA to split out rows and divide data

charleymax

New Member
Joined
Sep 10, 2010
Messages
39
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....

2mq3n2u.jpg
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
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

Well-known Member
Joined
Jun 30, 2008
Messages
6,653
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.

Code:
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

New Member
Joined
Sep 10, 2010
Messages
39

ADVERTISEMENT

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

Well-known Member
Joined
Jun 30, 2008
Messages
6,653
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.

Code:
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

New Member
Joined
Sep 10, 2010
Messages
39
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! :LOL: ;)
 

Watch MrExcel Video

Forum statistics

Threads
1,122,561
Messages
5,596,853
Members
414,107
Latest member
Tigretto

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top