none
Excel VBA - need help RRS feed

  • Question

  • Thanks for any help in advance. 

    I have an excel spreadsheet example that I need help with which will prevent me from manually manipulating 1000’s of records.

    Please refer to the Before and After screenshots. 

    Notice in Column E (D_Req) the records can contain a string with multiple Chr(10) linebreaks.  Notice in the After I need those parts of the record to be split and moved to a new line(s) below each the original records.  The value in Column D (Number) needs to be duplicated with each of these splits.   I can't insert images until my account has been verified and I new to this forum. See below:

    Number D_Req
    AA_1 D_Req_1.1 (x/xxxx) Then some Text. D_Req_1.2 (x/xxxx) Then some Text. D_Req_1.3 (x/xxxx) Then some Text.

    After:

    Number D_Req
    AA_1 D_Req_1.1 (x/xxxx) Then some Text.
    AA_1 D_Req_1.2 (x/xxxx) Then some Text.
    AA_1 D_Req_1.3 (x/xxxx) Then some Text.

    I like working with Arrays but, I’m not that good at it.

    I know how to load an Array:

    Sub Load_Array()
    
    Dim i As Long
    Dim j As Long
    ReDim myArray(1 To lRow, 1 To lCol)
    
        For i = 1 To lRow
            For j = 1 To lCol
                myArray(i, j) = Worksheets(targetSheet).Cells(i, j).Value
            Next
        Next
    
    End Sub


    I can detect the number iterations it will take or the number of new records I need to open below each record (notice the I column) where I detected the number of “(“ minus one in the “Before” shot.  I know the total number of new lines I need which I wrote to “J1”  but, I just can’t fit it all together.

    Can anyone help please

    Thanks in advance

     Willie



    • Edited by WillieWillie Thursday, November 29, 2018 12:46 PM edited
    Thursday, November 29, 2018 1:24 AM

Answers

  • sorry i wasnt able to see the before and after table here is the code for the table starting on d1 and e1 range:

    redim works for dynamic matrix and arrays.

    please mark as awnsered and vote for my posts :)

    Sub Load_Array()
    X = 1
    Dim i As Long
    Dim j As Long
    ReDim matrix(Range("d2").End(xlDown).Row - 1, 1)
    matrix = Range(Cells(1, 4), Cells(Range("d2").End(xlDown).Row, 5))
        For i = LBound(matrix) To UBound(matrix)
        splitvector = Split(matrix(i, 2), Chr(10))
                For counter = 0 To UBound(splitvector)
                    Cells(X, 7) = splitvector(counter)
                    Cells(X, 6) = matrix(i, 1)
                    X = X + 1
                Next counter
       
        Next i
       
    End Sub

    Friday, November 30, 2018 6:05 AM

All replies

  • try split function:

    Sub Load_Array()

    Dim i As Long
    Dim j As Long
    ReDim myArray(1 To lRow, 1 To lCol)
    x = 1
        For i = 1 To lRow
            For j = 1 To lCol
                splitvector = Split(Worksheets(Sheet).Cells(i, j).Value, Chr(10))
                For counter = 0 To UBound(splitvector)
                    Cells(x, 4) = splitvector(counter)
                    x = x + 1
                Next counter
            Next
        Next

    End Sub

    Thursday, November 29, 2018 5:35 AM
  • Thanks for the reply

    I think you are heading in the correct direction but, not exactly what I need.  Please notice Columns D & E below.  "Number" is in a header row also D_Req is a header.

    ColumnD ColumnE  referencing which columns

    They are not part of the data

    Number AA_1, AA2, AA3,& AA4 are different Rows of data.

    Notice Column E has multiple D_Req's.  D_Req_1.1, D_Req_1.2, & D_Req_1.3 separated by a Chr(10) linefeed for the row that contains AA_1. AA_2, etc in Column D.

    I need to split Column E and open two (2) rows below the current AA_1 row (Row 2) then duplicate the "AA_1" string in Column D.  Please refer below at the Before & After Data

    Before Data

    ColumnD ColumnE
    Number D_Req
    AA_1 D_Req_1.1 (x/xxxx) Then some   Text.
        D_Req_1.2 (x/xxxx) Then some Text.
        D_Req_1.3 (x/xxxx) Then some Text.
    AA_2 D_Req_2.1 (x/xxxx) Then some   Text.
        D_Req_2.2 (x/xxxx) Then some Text.
    AA_3 D_Req_3.1 (x/xxxx) Then some   Text.
    AA_4 D_Req_4.1 (x/xxxx) Then some   Text.
        D_Req_4.2 (x/xxxx) Then some Text.
        D_Req_4.3 (x/xxxx) Then some Text.
        D_Req_4.4 (x/xxxx) Then some Text.
        D_Req_4.5 (x/xxxx) Then some Text.

    After Data

    ColumnD ColumnE

    Number D_Req
    AA_1 D_Req_1.1 (x/xxxx) Then some   Text.
    AA_1 D_Req_1.2 (x/xxxx) Then some   Text.
    AA_1 D_Req_1.3 (x/xxxx) Then some   Text.
    AA_2 D_Req_2.1 (x/xxxx) Then some   Text.
    AA_2 D_Req_2.2 (x/xxxx) Then some   Text.
    AA_3 D_Req_3.1 (x/xxxx) Then some   Text.
    AA_4 D_Req_4.1 (x/xxxx) Then some   Text.
    AA_4 D_Req_4.2 (x/xxxx) Then some Text.
    AA_4 D_Req_4.3 (x/xxxx) Then some Text.
    AA_4 D_Req_4.4 (x/xxxx) Then some Text.
    AA_4 D_Req_4.5 (x/xxxx) Then some Text.

    My thought is to load the data into an Array  which would be lRow = 5 & lCol = 10 ( there is other data I'm not showing), manipulate the data as described above, and rewrite the manipulated data to the sheet.  I can't see a problem with overwriting the sheet because it will only grow in rows not shrink.

    Thanks again for any help.






    • Edited by WillieWillie Thursday, November 29, 2018 4:22 PM edit
    Thursday, November 29, 2018 3:04 PM
  • I got a little further.  I now have the line split and in a separate Array.  Now this is a jumbled up mess of testing.

    myArray contains all the data.  I can loop thru this Array and produce another Array (LArray) that contains the split based on Chr(10).  See code below.  Again the code is for testing and I don't really know how to do this.For Row two the Array ends up with:

    LArray(0) = "D_Req_1.1 (x/xxxx) Then some Text."

    LArray(1) = "D_Req_1.2 (x/xxxx) Then some Text."

    LArray(2) = "D_Req_1.3 (x/xxxx) Then some Text."

    Now I just need to know how to Add rows to the original Array (myArray), write the data from LAarray (0-2),  and once completed for all rows, write then entire Array to the sheet.

    I've read about Redim Preserve and I kinda understand it but, I can't wrap my mind around how to make it work in this case.

    Thanks again for any help

    Sub Split_me()
    Dim LString As String
    'Dim LArray() As String
    Dim LArray2String As String
    'Dim UArray As Long
    'Dim LArray As Long
    Dim i As Long
    
    
        For i = LBound(myArray) + 1 To UBound(myArray)
    
            'LString = Worksheets(targetSheet).Cells(i, 5).Value
            LString = myArray(i, 5)
    
            Dim phrase As String
                phrase = "("
            
            Dim X As Integer
            charcounter = 0
                For X = 1 To Len(LString)
                    If Mid(LString, X, 1) = phrase Then
                        charcounter = charcounter + 1
                    End If
                Next
                
                ReDim myTempArray(charcounter)
            LArray = Split(LString, Chr(10))
            LArray2 = Split(LArray(i), " (")
            myTempArray(i) = LArray2(0)
    
            
            ActiveSheet.Cells(i, 5).Select
            ac = ActiveCell.Value
            
            'a = Str(charcounter - 1)
            a = charcounter - 1
            b = UBound(myArray) + a
            
            'ReDim Array2(1 To lCol, 1 To b)
            
            
            ActiveCell.Offset(0, 4) = a
            
            'ActiveCell.Offset(1).EntireRow.Insert Shift:=xlShiftDown
            ''''ActiveCell.Offset(1).EntireRow.Resize(charcounter - 1).Insert Shift:=xlShiftDown
            
                    
        Next
    
    Range("I1").Select
    b = "rowInsertCnt"
    ActiveCell.Offset(0, 0) = b
    
    Range("J1").Select
        ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
    '    Range("J2").Select
    
    
    
    
    
    
    End Sub



    • Edited by WillieWillie Thursday, November 29, 2018 6:46 PM edited
    Thursday, November 29, 2018 6:44 PM
  • sorry i wasnt able to see the before and after table here is the code for the table starting on d1 and e1 range:

    redim works for dynamic matrix and arrays.

    please mark as awnsered and vote for my posts :)

    Sub Load_Array()
    X = 1
    Dim i As Long
    Dim j As Long
    ReDim matrix(Range("d2").End(xlDown).Row - 1, 1)
    matrix = Range(Cells(1, 4), Cells(Range("d2").End(xlDown).Row, 5))
        For i = LBound(matrix) To UBound(matrix)
        splitvector = Split(matrix(i, 2), Chr(10))
                For counter = 0 To UBound(splitvector)
                    Cells(X, 7) = splitvector(counter)
                    Cells(X, 6) = matrix(i, 1)
                    X = X + 1
                Next counter
       
        Next i
       
    End Sub

    Friday, November 30, 2018 6:05 AM
  • This work beautiful but, I didn't give you all the requirements. 

    1. My sheet has data in columns A-H which must remain on the original Row.  Sorry I didn't mention this
    2. I need Number and D_Req columns to remain in columns D & E.

    Sorry for not stating the requirements more clearly.

    Thanks again for your help

    • Marked as answer by WillieWillie Friday, December 7, 2018 5:10 PM
    • Unmarked as answer by WillieWillie Friday, December 7, 2018 5:10 PM
    Friday, November 30, 2018 2:06 PM
  • Based on what you gave me I was able to modify it and get it to work.  This may not be the best way but, it works

    Sub Load_Array98()
      X = 1
     Dim i As Long
     Dim j As Long
     
         Columns("F:R").Select
        Selection.Delete Shift:=xlToLeft

    Range("A1").Select
     
     ReDim matrix(Range("A2").End(xlDown).Row - 1, 5)
     matrix = Range(Cells(1, 1), Cells(Range("A2").End(xlDown).Row, 5))

        For i = LBound(matrix) To UBound(matrix)
         splitvector = Split(matrix(i, 5), Chr(10))
                 For counter = 0 To UBound(splitvector)
                     Cells(X, 5) = splitvector(counter)
                     Cells(X, 4) = matrix(i, 4)
                     Cells(X, 3) = matrix(i, 3)
                     Cells(X, 2) = matrix(i, 2)
                     Cells(X, 1) = matrix(i, 1)
                    
                     X = X + 1
                 Next counter
        
         Next i
        
     End Sub

    Friday, November 30, 2018 3:59 PM