Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 26

Thread: Unmerge Cells & Copy Cells Down to Next Line of Data

  1. #1
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location

    Unmerge Cells & Copy Cells Down to Next Line of Data

    Hello!

    I have a (what I believe to be) fairly simple request I am looking to achieve with Excel VBA.

    Please see attached report.

    I am simply looking to unmerge each grouped cell in column D (Org Level 3) and copy the first line down to the next line. See images below:

    Current State:


    Goal State:



    Simply put, the macro/VBA code should unmerge the data in column D and copy the first line down to the last line until the data changes, and loop for each area to the bottom of the data. Additionally, you will notice in line 1227 where column A is "Warehouse" - the code should disregard this section since the column D is not grouped. I.e., stop where the column A line = "warehouse".

    I am planning to macro record the unmerge of the first group starting at the top and try to have it loop until it reaches warehouse then stop but am not exactly sure how to write this.

    Thanks so much for the help!
    Attached Files Attached Files

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Try this


    Option Explicit
    
    
    Sub UnmergeAndFill()
        Dim rowLast As Long, i As Long
        Dim aryAreas() As Range
        Dim cntAreas As Long
        
        With Worksheets("HIN")
            rowLast = .Cells(.Rows.Count, 4).End(xlUp).Row
    
    
            i = 2
            Do While i <= rowLast
                If .Cells(i, 4).MergeCells Then
                    cntAreas = cntAreas + 1
                    ReDim Preserve aryAreas(1 To cntAreas)
                    Set aryAreas(cntAreas) = .Cells(i, 4).MergeArea
                End If
                
                i = .Cells(i, 4).End(xlDown).Row
            Loop
    
    
            For i = LBound(aryAreas) To UBound(aryAreas)
                aryAreas(i).UnMerge
                aryAreas(i).Value = aryAreas(i).Cells(1, 1).Value
            Next i
        End With
    
    
        MsgBox "Done"
    
    
    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

  3. #3
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    This works perfectly, thanks so much!

  4. #4
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    How would I modify this to iterate through all sheets in the workbook (there are 25), except for the first sheet (which is an instruction sheet).

    I've tried the following (not sure how to exclude the first sheet so I figured i'd just have it run anyway, through the sheet doesnt have any numbers) but this doesn't work, it doesn't even return an error:

    Public Sub IterateSheets()Dim S As Integer
    S = 1
    Do While S = Worksheets.Count
    Worksheets(S).Select
    UnmergeAndFill
    S = S + 1
    Loop
    End Sub
    
    Public Sub UnmergeAndFill()
    ' Unmerge and Fill
    Dim rowLast As Long, i As Long
    Dim aryAreas() As Range
    Dim cntAreas As Long
    rowLast = .Cells(.Rows.Count, 4).End(xlUp).Row
    i = 2
    Do While i <= rowLast
    If .Cells(i, 4).MergeCells Then
    cntAreas = cntAreas + 1
    ReDim Preserve aryAreas(1 To cntAreas)
    Set aryAreas(cntAreas) = .Cells(i, 4).MergeArea
    End If
    i = .Cells(i, 4).End(xlDown).Row
    Loop
    For i = LBound(aryAreas) To UBound(aryAreas)
    aryAreas(i).UnMerge
    aryAreas(i).Value = aryAreas(i).Cells(1, 1).Value
    Next i
    End With
    ' Unmerge and fill
    End Sub

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Option Explicit
    
    
    Sub UnmergeAndFill()
        Dim rowLast As Long, i As Long
        Dim aryAreas() As Range
        Dim cntAreas As Long
        Dim ws As Worksheet
        
        For Each ws In ThisWorkbook.Worksheets
            With ws
                If .Name = "Instructions" Then GoTo NextSheet
            
                Erase aryAreas
                ReDim aryAreas(1 To 1)
                cntAreas = 0
            
                rowLast = .Cells(.Rows.Count, 4).End(xlUp).Row
        
                i = 2
                Do While i <= rowLast
                    If .Cells(i, 4).MergeCells Then
                        cntAreas = cntAreas + 1
                        ReDim Preserve aryAreas(1 To cntAreas)
                        Set aryAreas(cntAreas) = .Cells(i, 4).MergeArea
                    End If
                    
                    i = .Cells(i, 4).End(xlDown).Row
                Loop
        
        
                For i = LBound(aryAreas) To UBound(aryAreas)
                    aryAreas(i).UnMerge
                    aryAreas(i).Value = aryAreas(i).Cells(1, 1).Value
                Next i
            End With
    
    
    NextSheet:
        Next
    
    
        MsgBox "Done"
    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

  6. #6
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    Hello! Thanks for the help. This returns an error, however.

    err1.png

    err2.jpg

    Any ideas on this?

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    It works OK when the worksheets have the proper format (see attachment), so I'm guessing that a worksheet is formatted differently

    Add the marked line and see which worksheet caused the issue and maybe attach a workbook with just the problematic worksheet


            With ws
            
                MsgBox .Name    '  <<<<<<<<<<<<<<<<<<<<<<<
            
                If .Name = "Instructions" Then GoTo NextSheet
    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

  8. #8
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    I've attached the updated workbook (with multiple sheets) here.

    The code below works perfectly, I just need it to iterate through all sheets (excluding "Instructions") in the workbook (there are 25, I just included a few).

    Public Sub UnmergeAndFill()
    
    Dim rowLast As Long, i As Long
    Dim aryAreas() As Range
    Dim cntAreas As Long
        
        With Worksheets("Raw Data")
            rowLast = .Cells(.Rows.Count, 4).End(xlUp).Row
    
    
    
    
            i = 2
            
            Do While i <= rowLast
                If .Cells(i, 4).MergeCells Then
                    cntAreas = cntAreas + 1
                    ReDim Preserve aryAreas(1 To cntAreas)
                    Set aryAreas(cntAreas) = .Cells(i, 4).MergeArea
                End If
                
                i = .Cells(i, 4).End(xlDown).Row
            Loop
    
    
            For i = LBound(aryAreas) To UBound(aryAreas)
                aryAreas(i).UnMerge
                aryAreas(i).Value = aryAreas(i).Cells(1, 1).Value
            Next i
        End With
    
    
    End Sub
    Thanks again for the help!
    Attached Files Attached Files

  9. #9
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    That should be:

    Public Sub UnmergeAndFill()    Dim rowLast As Long, i As Long
        Dim aryAreas() As Range
        Dim cntAreas As Long
        Dim ws As Worksheet
        
        For Each ws In ThisWorkbook.Worksheets
            With ws
                If .Name <> "Instructions" Then
                    rowLast = .Cells(.Rows.Count, 4).End(xlUp).Row
                    i = 2
                    Do While i <= rowLast
                        If .Cells(i, 4).MergeCells Then
                            cntAreas = cntAreas + 1
                            ReDim Preserve aryAreas(1 To cntAreas)
                            Set aryAreas(cntAreas) = .Cells(i, 4).MergeArea
                        End If
                        i = .Cells(i, 4).End(xlDown).Row
                    Loop
                    For i = LBound(aryAreas) To UBound(aryAreas)
                        aryAreas(i).UnMerge
                        aryAreas(i).Value = aryAreas(i).Cells(1, 1).Value
                    Next i
                End If
            End With
        Next ws
    End Sub
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by t0mato View Post
    I've attached the updated workbook (with multiple sheets) here.

    The code below works perfectly, I just need it to iterate through all sheets (excluding "Instructions") in the workbook (there are 25, I just included a few).

    Thanks again for the help!
    I believe that the macro from my Post#5 already does what you want.

    The 'For Each' loops through all WS

    The If .Name ... skips 'Instructions'

        For Each ws In ThisWorkbook.Worksheets
            With ws
            
                If .Name = "Instructions" Then GoTo NextSheet
    Using the sample XLSX from your post #8, it ran to completion without error


    Since you changed the above to a specific worksheet, it would not do all sheets

        With Worksheets("Raw Data")
    Attached Files Attached Files
    Last edited by Paul_Hossler; 01-21-2022 at 09:38 AM.
    ---------------------------------------------------------------------------------------------------------------------

    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

  11. #11
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Sorry Paul, missed that...
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    ---------------------------------------------------------------------------------------------------------------------

    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

  13. #13
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    You're right! It does work.. I was just adding the code to the wrong module (sorry I'm new to this). I made it a Public code and saved it to my PERSONAL project. When running from there, I get the error mentioned above. I thought in making it Public I could run it in any workbook? In other words, I get the error when I add the macro/module to my PERSONAL project. When I add it to the currently opened workbook, it works fine.

  14. #14
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Then use

     ... In ActiveWorkbook.Worksheets
    and not

     ... In ThisWorkbook.Worksheets
    Excel can only do what you tell it to do
    ---------------------------------------------------------------------------------------------------------------------

    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

  15. #15
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    Wow. I am still very much a VBA novice (obviously) with only one course under my belt. Still a lot to learn clearly.

    If I want to apply filters to each sheet, I think I would need to add the autofilter clause somewhere within the loop. Any ideas on where this should be added? Is it Selection.Autofilter? Will it need to be in a separate loop?

  16. #16
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    If I want to apply filters to each sheet, I think I would need to add the autofilter clause somewhere within the loop.
    Probably

    That could be a little tricky

    More details and an example would be helpful
    ---------------------------------------------------------------------------------------------------------------------

    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

  17. #17
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    Thanks again for all of the help. I'd just like to add the filter buttons (Ctrl + shift + L) to each sheet. So once it does the unmerge & fill, just apply filter buttons to the columns. Let me know if further information is needed!

  18. #18
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I don't have any unmodified data to test with, but I think just adding the last line would do it

                For i = LBound(aryAreas) To UBound(aryAreas)                aryAreas(i).UnMerge
                    aryAreas(i).Value = aryAreas(i).Cells(1, 1).Value
                Next i
                
                If Not .AutoFilterMode Then .Rows(1).AutoFilter
    ---------------------------------------------------------------------------------------------------------------------

    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

  19. #19
    VBAX Regular
    Joined
    Dec 2021
    Posts
    13
    Location
    This works perfectly. Thanks for all of the help!

    I do have one final question with this. If I wanted to apply the same process to different columns, where is the code would this be adjusted? Right now it is doing the merge & unfill on column C. I now need it to apply to columns A-F. I've done my best to find where it defines to apply to column C so that I may adjust accordingly but cannot figure it out.

    Any help here would be greatly appreciated!

  20. #20
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Like this?


    Option Explicit
    
    
    Sub UnmergeAndFill()
        Dim r As Long, c As Long
        Dim rData As Range
        Dim ws As Worksheet
        
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name = "Instructions" Then GoTo NextSheet
            
            ws.Range("A:F").UnMerge
            
            Set rData = ws.Cells(1, 1).CurrentRegion
                    
            With rData
                For r = 3 To .Rows.Count
                    For c = 1 To 6
                        If Len(.Cells(r, c).Value) = 0 Then .Cells(r, c).Value = .Cells(r - 1, c).Value
                    Next c
                Next r
            End With
                
            If Not ws.AutoFilterMode Then ws.Rows(1).AutoFilter
    
    
    NextSheet:
        Next
    
    
        MsgBox "Done"
    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

Posting Permissions

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