• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Code that can get a price record w multiple values in single cell, replicated into several unique

please read attached file

i am desperate for your help

i need a VBA code that can create unique records consisting of replicating from an original record --that has more than 1 value edited in a single cell (below a header)-- as many "new" records needed : each 'new' record displaying each single value in the cell(s). in other words the new records output by VBA code should be unique records no longer showing more than 1 text string or value in a single cell

please, help...you guys are my only hope!!

the raw data would be deposited on 1 tab of the workbook containing the Code. Running process via a button, the results of the replication would be shown on a new separate tab.
please read workbook attached for more explanation

my english is not good, hope you guys/gals are able to understand what im trying to relay

in advance: thanks for taking time to read my post and hopefully one of you can provide a reliable code in order to process thousands of records in a minimal time! :)
 

Attachments

  • example of record that needs to be replicated.xlsx
    20 KB · Views: 4
1) Place a button for yourself.
2) Change With Sheet(3).[a2] to your actual output sheet name
Code:
Sub test()
    Dim a, b, e, s, i As Long, ii As Long, n As Long, x, y
    a = [a5].CurrentRegion.Value
    ReDim b(1 To 10000, 1 To UBound(a, 2))
    For i = 2 To UBound(a, 1)
        If a(i, 8) = "" Then ReDim x(0) Else x = Split(a(i, 8))
        If a(i, 9) = "" Then ReDim y(0) Else y = Split(a(i, 9))
        For Each e In x
            For Each s In y
                n = n + 1
                For ii = 1 To UBound(a, 2)
                    b(n, ii) = a(i, ii)
                    If ii = 8 Then b(n, ii) = e
                    If ii = 9 Then b(n, ii) = s
    Next ii, s, e, i
    With Sheets(3).[a2].Resize(n, UBound(b, 2))
        .CurrentRegion.Offset(1).ClearContents
        .Value = b: .Parent.Select
    End With
End Sub
 
@jindon...

sir...sorry to bother you again

here is my updated file

would you be so kind to look again at the vba coding and fix whatever is causing the code to crash? (maybe the coding is not covering the whole region of data subject for processing?)

the original record qty is aprox 6000 rows
im guessing the result of the VBA coding should be about 10000 or 15000 "new" records with unique values per cell

i appreciate in advance your assistance and am grateful for your time!
 

Attachments

  • example of record that needs to be replicated v3 for Jindon.xlsm
    324 KB · Views: 2
Expand the size of array b for the safty
e.g to 100000
Code:
ReDim b(1 To 100000, 1 To UBound(a, 2))
 
Back
Top