• 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.

Cell Value split

shantraj.antin@gmail.com

shantraj.antin@gmail.com

Member
Dear Team,

In the sample file under data sheet I have four columns. From Column "field" I am looking for a cell value to be splited in for the number of times # is present and the data need to added in the new row. In the output sheet the sample is created manually.

Kidnly help on this issue.

Regards,
Raj
 

Attachments

  • Sample File.xlsx
    10 KB · Views: 10
Code: 
Sub SMC()

    Dim var As Variant, varOut As Variant, varFomat As Variant, lngRow As Long, lngRow2 As Long, lngCol As Long, lngIndex As Long
    Const clngSplitCol As Long = 3
    With Worksheets("Sheet1").Range("B1:E7")
        var = .Value2
        ReDim varFomat(1 To 1, 1 To .Columns.Count)
        For lngCol = 1 To UBound(varFomat, 2)
            varFomat(1, lngCol) = .Cells(.Rows.Count, lngCol).NumberFormat
        Next lngCol
    End With
    ReDim varOut(1 To 999, 1 To UBound(var, 2))
    For lngRow = LBound(var) To UBound(var)
        For lngRow2 = 0 To UBound(Split(var(lngRow, clngSplitCol), ";#"))
            lngIndex = lngIndex + 1
            For lngCol = 1 To UBound(var, 2)
                If lngCol <> clngSplitCol Then
                    varOut(lngIndex, lngCol) = var(lngRow, lngCol)
                Else
                    varOut(lngIndex, lngCol) = Split(var(lngRow, clngSplitCol), ";#")(lngRow2)
                End If
            Next lngCol
        Next lngRow2
    Next lngRow
    With Worksheets("Output")
        .Cells(1, 2).CurrentRegion.Clear
        .Cells(1, 2).Resize(lngIndex, lngCol - 1).Value = varOut
        For lngCol = 1 To lngCol - 1
            .Cells(2, 1 + lngCol).Resize(lngIndex - 1).NumberFormat = varFomat(1, lngCol)
        Next lngCol
    End With
    
End Sub
 
Hi Sam,

Thanks for your support.

When I try to implement the above code for large set of data the value split is not happening. I updated the range in the code but the field values in column are not being split in the out put worksheet.

Regards,
Raj
 

Attachments

  • Sample File 1.xlsx
    31.1 KB · Views: 3
Hi, shantraj.antin@gmail.com!

If you want to give a try to a formula only solution give a look at the uploaded file.

It uses 2 helper columns in original data source (worksheet Sheet1, columns F:G as follows:
F1: "# Items"
G1: 0
F2: =(LARGO(D2)-LARGO(SUSTITUIR(D2;";#";"")))/2+1 -----> in english: =(LEN(D2)-LEN(SUBSTITUTE(D2,";#","")))/2+1
G2: =SUMA(F$2:F2)+0,001 -----> in english: =SUM(F$2:F2)+0.001
Copy down F2:G2 as required.

Check the 3rd worksheet, OutputFormulaOnly:

B2: =SI.ERROR(INDICE(Sheet1!$B$2:$E$7;COINCIDIR(FILA()-1;Sheet1!$G$1:$G$7;1);COLUMNA()-1);"") -----> in english: =IFERROR(INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1),"")

D2: =SI.ERROR(EXTRAE(SUSTITUIR(SUSTITUIR(";#"&INDICE(Sheet1!$B$2:$E$7;COINCIDIR(FILA()-1;Sheet1!$G$1:$G$7;1);COLUMNA()-1)&";#";";#";"@@";CONTAR.SI(E$2:E2;E2));";#";"&&";CONTAR.SI(E$2:E2;E2));HALLAR("@@";SUSTITUIR(SUSTITUIR(";#"&INDICE(Sheet1!$B$2:$E$7;COINCIDIR(FILA()-1;Sheet1!$G$1:$G$7;1);COLUMNA()-1)&";#";";#";"@@";CONTAR.SI(E$2:E2;E2));";#";"&&";CONTAR.SI(E$2:E2;E2)))+2;HALLAR("&&";SUSTITUIR(SUSTITUIR(";#"&INDICE(Sheet1!$B$2:$E$7;COINCIDIR(FILA()-1;Sheet1!$G$1:$G$7;1);COLUMNA()-1)&";#";";#";"@@";CONTAR.SI(E$2:E2;E2));";#";"&&";CONTAR.SI(E$2:E2;E2)))-HALLAR("@@";SUSTITUIR(SUSTITUIR(";#"&INDICE(Sheet1!$B$2:$E$7;COINCIDIR(FILA()-1;Sheet1!$G$1:$G$7;1);COLUMNA()-1)&";#";";#";"@@";CONTAR.SI(E$2:E2;E2));";#";"&&";CONTAR.SI(E$2:E2;E2)))-2);"") -----> in english: =IFERROR(MID(SUBSTITUTE(SUBSTITUTE(";#"&INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1)&";#",";#","@@",COUNTIF(E$2:E2,E2)),";#","&&",COUNTIF(E$2:E2,E2)),SEARCH("@@",SUBSTITUTE(SUBSTITUTE(";#"&INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1)&";#",";#","@@",COUNTIF(E$2:E2,E2)),";#","&&",COUNTIF(E$2:E2,E2)))+2,SEARCH("&&",SUBSTITUTE(SUBSTITUTE(";#"&INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1)&";#",";#","@@",COUNTIF(E$2:E2,E2)),";#","&&",COUNTIF(E$2:E2,E2)))-SEARCH("@@",SUBSTITUTE(SUBSTITUTE(";#"&INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1)&";#",";#","@@",COUNTIF(E$2:E2,E2)),";#","&&",COUNTIF(E$2:E2,E2)))-2),"")

Copy across B2 to D2:E2.
Copy down B2:E2 as required, i.e., until the first blank cell appears in column B and then delete that last one row formulas (in the example the rows with the copied formula are yellow shaded in column B).

The slightly long formula for column D works as follows:

a) It builds a string as:
";#"&INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1)&";#","
i.e.:
";#"&<Field_Column_in_source_Worksheet>&";#","

b) Replaces the ";#" nth+1 and nth+2 occurences with "@@" and "&&" respectively:
SUBSTITUTE(SUBSTITUTE(";#"&INDEX(Sheet1!$B$2:$E$7,MATCH(ROW()-1,Sheet1!$G$1:$G$7,1),COLUMN()-1)&";#",";#","@@",COUNTIF(E$2:E2,E2)),";#","&&",COUNTIF(E$2:E2,E2))
which is:
SUBSTITUTE(SUBSTITUTE(<string_of_a>,COLUMN()-1)&";#",";#","@@",COUNTIF(E$2:E2,E2)),";#","&&",COUNTIF(E$2:E2,E2))

c) Extracts the characters between "@@" and "&&" that is:
MID(<string_of_b>,SEARCH("@@",<string_of_b>)+2,SEARCH("&&",<string_of_b>)-SEARCH("@@",<string_of_b>-2)

d) Encloses the extracted substring into an error trap:
=IFERROR(<string_of_c>,"")

Hope it helps. Just advise if any issue.

Regards!
 

Attachments

  • Cell Value split - Sample File (for shantraj.antin@gmail.com at chandoo.org).xlsx
    13.5 KB · Views: 3
Hi,​
​
as Sam, my code is based upon the original sample file …​
I do not choose the faster arrays way as Sam does - I began with it -​
only to keep the cells' color & format (avoiding also to reprocess date when not in US date format).​
Code: 
Sub SplitDemo()
    Dim Rg As Range
 
    K& = Application.Match("Field", Sheet1.Rows(1), 0):  If K = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Sheet2.[A1].CurrentRegion.Clear
 
    For Each Rg In Sheet1.[A1].CurrentRegion.Rows
        SP = Split(Rg.Cells(K).Value, ";")
        D% = UBound(SP) < 0
        Rg.Copy Sheet2.Cells(R& + 1, 1).Resize(UBound(SP) + 1 - D)
                           R = R - D
        For Each V In SP:  R = R + 1:  Sheet2.Cells(R, K).Value = V:  Next V
    Next Rg
 
    Application.ScreenUpdating = True
    Sheet2.Activate
End Sub
Easy to adapt ! I guess it should work with the last sample file just by matching​
the title of the column to split or directly assign its column number to K variable …​
 
hi Sirjb7,

Thanks for the excellent formula.

since the data range and number of columns in Sample file 1.xlsx are more hence macro would help me Sir.

Hi Marc L,

I tried to run the above code for Sample file 1.xlsx, but found an error.

The code provided by Sam is working for small range in sample file.xlsx. But when I tried to run the same for sample file 1. xlsx which dint give the accurate output.

Regards,
Raj
 
Hi Raj ,

This is an age-old problem !

When a problem is specified the first time , the poster is confident that if a sample specification is given , and a solution received , the same can be easily extended to accommodate the actual problem.

Why not give a clear specification of your problem right at the outset ? It saves your time , and the time of the person who has taken the trouble to work out a solution.

Your second file , which you are again calling Sample file 1.xlsx ( does this mean that this file also bears only a small resemblance to your real-life working file ? ) , is quite different from the initial file you uploaded.

Your initial file had only one column whose cells had the "#" symbol in them ; this was column 3 ; based on this , Sam has coded the following statement in his procedure :

Const clngSplitCol As Long = 3

In your second file , I find there are two columns which have the "#" symbol in them !

I do not know whether Sam has considered this possibility ; however , when I changed the above statement to :

Const clngSplitCol As Long = 13

the procedure did do a split ; how much it will satisfy your requirements , I do not know.

Narayan
 
Yes I agree NARAYANK991 !​
​
Error occurs in my previous code when the match is not found for K variable …​
Code: 
Sub SplitDemo()
    Dim Rg As Range
 
    K = Application.Match("Field", Sheet1.Rows(1), 0):  If IsError(K) Then Exit Sub
    Application.ScreenUpdating = False
    Sheet2.[A1].CurrentRegion.Clear
 
    For Each Rg In Sheet1.[A1].CurrentRegion.Rows
        SP = Split(Rg.Cells(K).Value, ";")
        D% = UBound(SP) < 0
        Rg.Copy Sheet2.Cells(R& + 1, 1).Resize(UBound(SP) + 1 - D)
                           R = R - D
        For Each V In SP:  R = R + 1:  Sheet2.Cells(R, K).Value = V:  Next V
    Next Rg
 
    Application.ScreenUpdating = True
    Sheet2.Activate
End Sub
The code works like a charm …​
… if you well update the split column title or its column number to K variable …​
Amazing, its reveals to be faster than the other way !​
​
I just try and have no error with the 13th column …​
Raj, which one is your column to split ?​
 
Hi Nayayan,

Good day! Sorry bro I dint catch to update the Const clngSplitCol As Long = 3

Code is working absolutely fine. Thanks for helping me and understand the same.

Hi Marc,

Thanks you now code is deriving the result. Thanks a lot :)

Once again thanks all Ninjas for helping on this problem.
 
You're welcome !​
​
My first code works if K variable is well updated …​
​
Raj, if you really like my code, just click at bottom right of my code post on Like, Thanks !​
​
Just note that the output with my code ends at row #310 and Sam's ends at #309 …​
​
With Sam's code the source row #16 is missing 'cause of a classic Split trap​
which occurs when there is nothing to process.​
​
Within my code, D variable is used to bypass this trap …​
 
:) I like the way you put it as Classic Split Trap.

Anyway, it's easily fixed by a simple concatenation

Code: 
Sub SMC()

    Dim var As Variant, varOut As Variant, varFomat As Variant, lngRow As Long, lngRow2 As Long, lngCol As Long, lngIndex As Long
    Const clngSplitCol As Long = 13
    With Worksheets("Sheet1").Range("B1:E7")
        var = .Value2
        ReDim varFomat(1 To 1, 1 To .Columns.Count)
        For lngCol = 1 To UBound(varFomat, 2)
            varFomat(1, lngCol) = .Cells(.Rows.Count, lngCol).NumberFormat
        Next lngCol
    End With
    ReDim varOut(1 To 999, 1 To UBound(var, 2))
    For lngRow = LBound(var) To UBound(var)
        For lngRow2 = 0 To UBound(Split(var(lngRow, clngSplitCol) & ";#", ";#")) - 1
            lngIndex = lngIndex + 1
            For lngCol = 1 To UBound(var, 2)
                If lngCol <> clngSplitCol Then
                    varOut(lngIndex, lngCol) = var(lngRow, lngCol)
                Else
                    varOut(lngIndex, lngCol) = Split(var(lngRow, clngSplitCol) & ";#", ";#")(lngRow2)
                End If
            Next lngCol
        Next lngRow2
    Next lngRow
    With Worksheets("Output")
        .Cells(1, 2).CurrentRegion.Clear
        .Cells(1, 2).Resize(lngIndex, lngCol - 1).Value = varOut
        For lngCol = 1 To lngCol - 1
            .Cells(2, 1 + lngCol).Resize(lngIndex - 1).NumberFormat = varFomat(1, lngCol)
        Next lngCol
    End With
   
End Sub
 
You must log in or register to reply here.
Back
Top