Consulting

Results 1 to 12 of 12

Thread: Text to Rows Macro : Subscript out of range

  1. #1

    Text to Rows Macro : Subscript out of range

    Hi Guys,

    I am trying to perform a text to rows for comma delimited column entries. I have included the screenshot of the raw data and the clean data. I am also including my code and a screenshot of it in the excel vba window. If you could please guide me with what I am doing wrong I would really appreciate it.

    Please assume columns B and C are switched around. I forgot to make that change!

    Capturevba.JPGCapturevba2.JPGCapturevba3.JPG
    Last edited by bhrigu; 11-04-2018 at 11:58 PM. Reason: The system wouldn't let me attach my code or images.

  2. #2
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    post your workbook pls.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  3. #3
    VBAX Regular
    Joined
    Oct 2018
    Posts
    18
    Location
    Hi all,

    Please try this code, I tried to reproduce your situation. I intentionally left an empty cell.
    I hope this helps.

    Sub Main()
    Dim I, J, Temp, LastRaw
    Dim RawD, CleanD As Worksheet
    
    Set RawD = ThisWorkbook.Sheets("RawData")
    Set CleanD = ThisWorkbook.Sheets("CleanedData")
    
    For I = 1 To RawD.Range("C" & Rows.Count).End(xlUp).Row
    
        LastRaw = CleanD.Range("A" & Rows.Count).End(xlUp).Row + 1 'Last raw to write after
        If Not IsEmpty(Range("C" & I)) Then         'avoid empty cells
            Temp = Split(Range("C" & I), ",")
            For J = LastRaw To UBound(Temp) + LastRaw
                CleanD.Cells(J, 1) = RawD.Cells(I, 1)     'to copy the cells in columns A and B
                CleanD.Cells(J, 2) = RawD.Cells(I, 2)     '************************************
                CleanD.Cells(J, 3) = Temp(J - LastRaw)    'We write the value in the CleanedData sheet
            Next J
        Else
                CleanD.Cells(LastRaw, 1) = RawD.Cells(I, 1)     'to copy the cells in columns A and B
                CleanD.Cells(LastRaw, 2) = RawD.Cells(I, 2)     '************************************
        End If
    Next I
    End Sub
    Attach1.jpgAttach2.jpg
    Last edited by Toubkal; 11-05-2018 at 06:14 AM. Reason: for attachment

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I usually have to test the upper bound when I use Split() and there's a chance of no data or no separator


    Option Explicit
    Sub test()
        Dim s As String
        Dim v As Variant
        
        s = "Has a Comma, In String"
        v = Split(s, ",")
        MsgBox v(0)
        MsgBox v(1)
        
        s = "No Comma Here"
        v = Split(s, ",")
        
        If UBound(v) > 0 Then
            MsgBox v(0)
            MsgBox v(1)
        Else
            MsgBox v(0)
        End If
        s = ""
        v = Split(s, ",")
        
        If UBound(v) > 0 Then
            MsgBox v(0)
            MsgBox v(1)
        ElseIf UBound(v) = -1 Then
            MsgBox "Empty string"
        Else
            MsgBox v(0)
        End If
    
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    Hi all,

    Thank you so much for your help. I cant figure out how I would attach an excel workbook here, so I am literally pasting everything here. Please excuse me. I am sure there is a better way I cant figure out.

    I need to perform a text to row using columns F and T.
    Attached Files Attached Files
    Last edited by bhrigu; 11-06-2018 at 03:32 PM.

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    At the bottom right, click [Go Advanced] and hen the 'paperclip' icon to first "Add Files", then "Browse" then "Upload"

    Make sure to remove or replace any personal, sensitive, confidential, or proprietary information first
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    I have updated my previous comment to attach the file I need to automate. Thank you so much in advance.

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    A2 has 2 names and T2 has 5 organizations

    Do you want 2 cleaned rows with
    Name#1, ...5 orgs
    Name#2 … 5 orgs

    Or 10 rows with all combanations (2 x 5 = 10)?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Regular
    Joined
    Oct 2018
    Posts
    18
    Location
    It would be better if you send an example of cleaned data for row 2. What to expect for F2 and T2 as Paul said (2 names vs 5 orgs.)

  10. #10
    Quote Originally Posted by Paul_Hossler View Post
    A2 has 2 names and T2 has 5 organizations

    Do you want 2 cleaned rows with
    Name#1, ...5 orgs
    Name#2 … 5 orgs

    Or 10 rows with all combanations (2 x 5 = 10)?

    I apologize for not explaining this better. We want 10 rows with all combinations (2 x 5 = 10)?

    For eg. for row 6, which looks like this:

    8044 9/7/2016 Frank Kauffman GRC Continuation Amy, Robin O&E - R&T 1 Processed Finished High C&M Customer NMA 2q, 23s, 4d, 9s Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00
    we want it like


    8044 9/7/2016 Frank Kauffman GRC Continuation Amy O&E - R&T 1 Processed Finished High C&M Customer NMA 2q Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00
    8044 9/7/2016 Frank Kauffman GRC Continuation Amy O&E - R&T 1 Processed Finished High C&M Customer NMA 23s Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00
    8044 9/7/2016 Frank Kauffman GRC Continuation Amy O&E - R&T 1 Processed Finished High C&M Customer NMA 4d Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00

    8044 9/7/2016 Frank Kauffman GRC Continuation Amy O&E - R&T 1 Processed Finished High C&M Customer NMA 9s Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00

    8044 9/7/2016 Frank Kauffman GRC Continuation Robin O&E - R&T 1 Processed Finished High C&M Customer NMA 2q Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00

    8044 9/7/2016 Frank Kauffman GRC Continuation Robin O&E - R&T 1 Processed Finished High C&M Customer NMA 23s Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00

    8044 9/7/2016 Frank Kauffman GRC Continuation Robin O&E - R&T 1 Processed Finished High C&M Customer NMA 4d Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00
    8044 9/7/2016 Frank Kauffman GRC Continuation Robin O&E - R&T 1 Processed Finished High C&M Customer NMA 9s Phase 2 scope execution complete 8/29/2016 9:00 8/29/2016 9:00

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    This isn't the fastest but it is the most straight-forward




    Option Explicit
    
    Sub Raw2Cleaned()
        Dim wsRaw As Worksheet, wsClean As Worksheet
        Dim f As Long, t As Long, rowClean As Long, rowRaw As Long
        Dim aryF As Variant, aryT As Variant
        
        Application.ScreenUpdating = False
        
        Set wsRaw = Worksheets("RawData")
        Set wsClean = Worksheets("CleanedData")
        
        wsClean.Cells.Clear
        wsRaw.Rows(1).Copy wsClean.Rows(1)
        rowClean = 2
    
        For rowRaw = 2 To wsRaw.Cells(1, 1).CurrentRegion.Rows.Count
                
            Application.StatusBar = rowRaw
            
            With wsRaw.Rows(rowRaw)
                aryF = Split(.Cells(6).Value, ",")
                aryT = Split(.Cells(20).Value, ",")
                
                For f = LBound(aryF) To UBound(aryF)
                    For t = LBound(aryT) To UBound(aryT)
                        .Copy wsClean.Rows(rowClean)
                        wsClean.Cells(rowClean, 6) = aryF(f)
                        wsClean.Cells(rowClean, 20) = aryT(t)
                        rowClean = rowClean + 1
                    Next t
                Next f
            End With
                
            DoEvents
        
        Next rowRaw
    
        Application.StatusBar = False
        Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    VBAX Regular
    Joined
    Oct 2018
    Posts
    18
    Location
    Hi,

    Try this code, it's similar to the code above but taking into account blank cells.
    If a cell in column F is empty: it just copies the entire line and continues to next line.
    If a cell in column T is empty: it does text to rows for each name in column F (w/ empty cells in T)

    Sub Main()
    Dim I, J, K, TempF, TempT
    Dim RawD, CleanD As Worksheet
    Set RawD = ThisWorkbook.Sheets("RawData")
    Set CleanD = ThisWorkbook.Sheets("CleanedData")
    CleanD.Cells.Clear
    Application.ScreenUpdating = False
    
    LastRow = CleanD.Range("A" & Rows.Count).End(xlUp).Row
    For I = 1 To RawD.Range("A" & Rows.Count).End(xlUp).Row
    
        If IsEmpty(Range("F" & I)) Then                 'no data in F --> copy entire line and continue, in case you want to do text to rows for each data in T, just replace 1 & 2 with MOD code below.
            RawD.Rows(I).Copy CleanD.Rows(LastRow)  '1
            LastRow = LastRow + 1                   '2
        ElseIf IsEmpty(Range("T" & I)) Then               'no data in T --> do text to rows for each name in F cell with empty cells in F column.
            TempF = Split(Range("F" & I), ",")
            For J = LBound(TempF) To UBound(TempF)
                    RawD.Rows(I).Copy CleanD.Rows(LastRow)
                    CleanD.Cells(LastRow, 6) = TempF(J)
                    LastRow = LastRow + 1
            Next J
        Else                                                             'Do text to rows job for
            TempF = Split(Range("F" & I), ",")
            TempT = Split(Range("T" & I), ",")
            For J = LBound(TempF) To UBound(TempF)
                For K = LBound(TempT) To UBound(TempT)
                    RawD.Rows(I).Copy CleanD.Rows(LastRow)
                    CleanD.Cells(LastRow, 6) = TempF(J)
                    CleanD.Cells(LastRow, 20) = TempT(K)
                    LastRow = LastRow + 1
                Next K
            Next J
        End If
    Next I
    Application.ScreenUpdating = True
    End Sub
    MOD:
                TempT = Split(Range("T" & I), ",")
                For K = LBound(TempT) To UBound(TempT)
                    RawD.Rows(I).Copy CleanD.Rows(LastRow)
                    CleanD.Cells(LastRow, 20) = TempT(K)
                    LastRow = LastRow + 1
                Next K
    Tested in your sample file.

    Good Luck.
    Last edited by Toubkal; 11-09-2018 at 05:25 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •