Adding rows based on comma value

smashclash

Board Regular
Joined
Nov 24, 2003
Messages
126
Office Version
  1. 365
Platform
  1. Windows
I have a set of data like below that I need to separate out. Rather than the data be broken out for each single instance of a name it's grouped together at times and summed the amt. So for example in the below picture I'd like Chip Dale and Vicky Micky to be in separate rows and each have an amount of $500. VBA could identify the need to break this out because of the comma in column A. Frank Tank in A3 would be no action since there are no commas. Chip Dale, Vicky Micky, Mike Ike in A5 would need two rows added and the 800 divided by 3 (266.67) since there are three names for the Amt.

For all the rows with commas the names should only appear one time after VBA runs. So it could work as follows. Search column A for a comma. FInd comma and insert the number of rows equivalent to the number of commas. Then adjust the Names so they only appear once. Example, search column A for comma, find one in Column A2. Clone row 2. Change name in row A2 to Chip Dale and amount to be 500. The new row added would be Vicky Micky and Amt is 500. Then repeat for any other commas in column A.



Names.PNG
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
like this?
NameAmtNameAmt
Chip Dale, Vicky Micky1,000.00Chip Dale500
Frank Tank300.00Vicky Micky500
Mitch Bub200.00Frank Tank300
Chip Dale, Vicky Micky, Mike Ike800.00Mitch Bub200
Larry Link5,000.00Chip Dale266.67
Vicky Micky266.67
Mike Ike266.67
Larry Link5000

with Power Query (Get&Transfrom)
Code:
// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Count = Table.AddColumn(Source, "Count", each List.Count(Text.Split([Name],","))),
    TSC = Table.SelectColumns(Table.TransformColumns(Table.AddColumn(Count, "Division", each [Amt] / [Count], type number),{{"Division", each Number.Round(_, 2), type number}}),{"Name", "Division"}),
    Split = Table.ExpandListColumn(Table.TransformColumns(TSC, {{"Name", Splitter.SplitTextByDelimiter(", ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Name"),
    Result = Table.RenameColumns(Split,{{"Division", "Amt"}})
in
    Result
 
Last edited:
Upvote 0
Amateur VBA which surely will be improved upon (but my first criteria is to get it to work!):

Code:
Sub Split_Share()
Dim LR As Long, com As Integer, i As Integer, r As Integer, name As String, nc As Integer
LR = Range("A" & Rows.Count).End(xlUp).Row
r = 2
For i = 2 To LR
name = Range("A" & i)
nc = 1 + Len(name) - Len(Replace(name, ",", ""))
name = name & ","
While Len(name) <> 0
com = InStr(name, ",")
    If com > 0 Then
      Cells(r, 3) = Left(name, com - 1)
      Cells(r, 4) = Range("B" & i) / nc
      r = r + 1
      name = Right(name, Len(name) - com)
    Else
      Cells(r, 3) = Cells(i, 1)
      Cells(r, 4) = Cells(i, 2)
      r = r + 1
End If
Wend
Next
End Sub
 
Upvote 0
.... and another approach ...
VBA Code:
Public Sub Example()

    Dim oWs     As Worksheet
    Dim oRng    As Range
    Dim lRows   As Long
    Dim i       As Long
    Dim n       As Integer
    Dim cyAmt   As Currency
    Dim vNames  As Variant

    Set oWs = ActiveSheet

    With oWs
        lRows = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = lRows To 2 Step -1
            Set oRng = .Range("A" & i)
            With oRng
            vNames = Split(.Text, ",")
                If UBound(vNames) > 0 Then
                    n = 0
                    cyAmt = .Offset(0, 1).Value / (UBound(vNames) + 1)
                    .Value = vNames(n)
                    .Offset(0, 1).Value = cyAmt
                    For n = 1 To UBound(vNames)
                        .Offset(n, 0).EntireRow.Insert
                        .Offset(n, 0).Value = Trim(vNames(n))
                        .Offset(n, 1).Value = cyAmt
                    Next n
                End If
            End With
        Next i
    End With
    Set oRng = Nothing
    Set oWs = Nothing
End Sub
 
Upvote 0
I change this line
Code:
name = Right(name, Len(name) - com)

to

[code'
name = TRIM(Right(name, Len(name) - com))[/code]
 
Upvote 0
Thanks everyone. I was hoping I could take the code posted and modify it to fit my needs but I just don't understand VBA enough yet. There's some additional data in other columns within the row I would like to copy down as well. Let's assume it's in column C-Z. How should the VBA from GWteB be tweaked? Column A and B would be the only ones that might get changed due to the criteria in Column A.
 
Upvote 0
Answer is tailored to your question (post#1)
Post representative example
 
Upvote 0
You'll have to provide more information about the other cells and how they relate to column A
 
Upvote 0
If you have the names in column A and amount 1 in column B and amount 2 in column C, this will split them, according to your original explanation, into columns E, F, and G, respectively.
Code:
Sub Split_Share()
Dim LR As Long, com As Integer, i As Integer, r As Integer, name As String, nc As Integer
LR = Range("A" & Rows.Count).End(xlUp).Row
r = 2
For i = 2 To LR
name = Range("A" & i)
name = name & ","
nc = Len(name) - Len(Replace(name, ",", ""))
While Len(name) <> 0
com = InStr(name, ",")
    If com > 0 Then
      Cells(r, 5) = Left(name, com - 1)  ' put individual names in column E
      Cells(r, 6) = Range("B" & i) / nc  ' split the amounts and put in column F     
      Cells(r, 7) = Range("C" & i) / nc ' split contents of  C into column G
      ' assuming it is also money, and divide it up accordingly
      r = r + 1
      name = Trim(Right(name, Len(name) - com))
    Else
      Cells(r, 5) = Cells(i, 1)
      Cells(r, 6) = Cells(i, 2)
      Cells(r, 7) = Cells(i, 3)
      r = r + 1
      r = r + 1
End If
Wend
Next
End Sub
 
Upvote 0
OK here is a snippet of the full report. Sorry for not just posting this to begin with. I thought it would be easier to understand what I wanted by only citing the "moving parts" to my problem.

The actual report contains many more rows but all the columns are here on the report I want to modify with VBA. The variable for the SalesReps names are in column AE. The amount that would be divided based on the number of Sales Reps names is Column T (Actual_Amount). What I want to do is for all rows that have multiple sales reps, clone the row with the multiple sales rep by adding a line below it and then dividing (the Actual_Amount) column T by the number of sales reps in Column AE. Then have those multiple sales reps represented only one time. So for example in the below report in cell AE9 there are 3 sales reps listed. I need row 9 to be cloned two times (because there are 3 names in it), then have the names in AE be: Chris Pilgrim in a row, Chris Tophe in the next row, and Lauren Lilly in the last row. The amount from Column T would then be divided by 3 (for the 3 Sales reps names) so it would go from $13,500 to $4,500. I'd like all the data in the other columns to be copied from the original row.



Weekly Example.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBR
1YearGroupBrandProduct LineIDAdvertiser_IDAdvertiser_NameBrand_IDBrand_NameLine_IDWebsite_IDStart_DateEnd_DateLineTypeCurrency_CodeRateEstimated_QtyEstimated_AmountActual_QtyActual_AmountIs_RONQty_ServedQty_Server_AsOfAuditStampWebsite_NameExternal_IDExternal_OrderIDAgency_NameStatusLineDescriptionSalesRepsIsNewsletterEstimatedNetActualNetFCEstimatedNetFCActualNetFCEstimatedAmountFCActualAmountProposalIDContractIDSizesRONWebsiteIDRONWebsiteNameSectionIDSectionNamePositionIDPositionNameHasPrePaymentCampaignTypeGLTypeIDGLTypeNameTrackingCurrenciesRatecardRateMaterialStatusCodeAdTypeIDAdTypeNameProductionControllerIDProductionControllerNameCampaignTypeDescriptionTCEstimatedNetTCActualNetTCEstimatedAmountTCActualAmountToolTipSelectedAdServerIDThirdPartyIDFourthPartyIDUDFAnswersCampaignDescription
22020 YTDPromoPromoLive Event100102434GilbertXXGilbert2511004090111/1/2019########FFUSD595016703.21 6,703.20 FALSE01.89186E+12Promo DCISStandard SponsorshipVicky MickyTRUE6703.26703.26703.26703.26703.26703.2Standard SponsorshipFALSEF1221SponsorshipsSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]595023SponsorshipsN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]MM.9921
32020 YTDPromoPMVideo1002102590KTIXXKTI51931024040111/1/2019########FFUSD50015001 500.00 FALSE01.89684E+12PM VideoISProduct VideoJesse Coat, Vicky MickyTRUE500500500500500500Product VideoFALSEF1620VideoSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]5000013Video-Flat FeeN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]Product Video Series 1
42020 YTDPromoPMVideo1002102590KTIXXKTI51941024040111/1/2019########FFUSD50015001 500.00 FALSE01.89684E+12PM VideoISProduct VideoJesse Coat, Vicky MickyTRUE500500500500500500Product VideoFALSEF1620VideoSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]5000013Video-Flat FeeN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]Product Video Series 1
52020 YTDPromoPMVideo1002102590KTIXXKTI51951024040111/1/2019########FFUSD50015001 500.00 FALSE01.89684E+12PM VideoISProduct VideoJesse Coat, Vicky MickyTRUE500500500500500500Product VideoFALSEF1620VideoSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]5000013Video-Flat FeeN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]Product Video Series 1
62020 YTDPromoPMVideo1002102590KTIXXKTI51961024040111/1/2019########FFUSD50015001 500.00 FALSE01.89684E+12PM VideoISProduct VideoJesse Coat, Vicky MickyTRUE500500500500500500Product VideoFALSEF1620VideoSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]5000013Video-Flat FeeN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]Product Video Series 1
72020 YTDTMNPPVideo1015102319SoftwareXXSoftware52591021040111/1/2019########FFUSD5500155001 5,500.00 FALSE01.89684E+12NPP VideoISTestimonial VideoChris TopheTRUE550055005500550055005500Testimonial VideoFALSEM1620VideoSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]5000013Video-Flat FeeN.SupportN.SupportPerformance0000FALSESystem.Collections.Generic.List`1[System.String]
82020 YTDPrintPIPrint1016103217CopierA1Copier52651001030111/15/2019########FFUSD4500145001 4,500.00 FALSE01.90013E+12PI the MagWavemaker GlobalISFull Page Chris PilgrimFALSE450045004500450045004500Full Page FALSEM1001PrintSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]78751ROPN.SupportN.SupportPerformance0000FALSESystem.Collections.Generic.List`1[System.String]Fall Advertising
92020 YTDPrintPKILive Event1017106975SignificantXXSignificant52671025090111/8/2019########FFUSD135001135001 13,500.00 FALSE01.89684E+12PKI DPSISSilver SponsorshipChris Pilgrim, Chris Tophe, Lauren LillyTRUE135001350013500135001350013500Silver SponsorshipTRUEF1221SponsorshipsSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]1350023SponsorshipsN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]
102020 YTDPrintPKILive Event1017106975SignificantXXSignificant52681025090111/8/2019########FFUSD1000110001 1,000.00 FALSE01.89684E+12PKI DPSISSponsor Additional Staff BadgeChris PilgrimTRUE100010001000100010001000Sponsor Additional Staff BadgeTRUEF1221SponsorshipsSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]250023SponsorshipsN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]
112020 YTDPrintPKILive Event1017106975SignificantXXSignificant52721025090111/8/2019########FFUSD35013501 350.00 FALSE01.89684E+12PKI DPSISGolf - Play GolfChris Pilgrim, Chris Tophe, Lauren LillyTRUE350350350350350350Golf - Play GolfTRUEF1221SponsorshipsSystem.Collections.Generic.List`1[Elan.Library.Ad.Internet.OrdersByWebsite+TrackingCurrency]35023SponsorshipsN.SupportN.SupportFlexible0000FALSESystem.Collections.Generic.List`1[System.String]
Sheet1
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,696
Members
448,293
Latest member
jin kazuya

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
Back
Top