Consolidate rows with a macro based on lack of value in certain columns
Page 1 of 2 12 LastLast
Results 1 to 10 of 13

Thread: Consolidate rows with a macro based on lack of value in certain columns

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Consolidate rows with a macro based on lack of value in certain columns

    I'm working on fixing a spreadsheet for work with very little VBA knowledge. I've got the original sheet working again but now would like to add a consolidation button for times when the outputted table is too long. This is an example of the output table from the macro: I'd like to output to a new sheet all of this same data, but for rows where an entry has no value in columns A-E or G-H, I'd like to consolidate in to one row and total up the amounts in columns F,I,J. I've seen something similar on this message board, but it needs tweaked just a little bit for my situation I believe, and I couldn't figure out the tweaking... Any help is much appreciated.

  2. #2
    New Member
    Join Date
    Aug 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    Just realized I can't post attachments I guess.

    Here's the example of the output table:
    https://drive.google.com/file/d/1krY...ew?usp=sharing

    And here's an example of the consolidation:
    https://drive.google.com/file/d/1XbF...ew?usp=sharing

  3. #3
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    Try this:-
    Code:
    Sub MG11Aug53
    Dim Rng As Range, Dn As Range, nRng As Range, Delrng As Range
    Set Rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
    With Application
     .ScreenUpdating = False
    
    For Each Dn In Rng
      If .CountA(Dn.Offset(, 2).Resize(, 5)) = 0 And .CountA(Dn.Offset(, 8).Resize(, 2)) = 0 Then
        If nRng Is Nothing Then
            Set nRng = Dn
        Else
            nRng.Offset(, 7) = nRng.Offset(, 7) + Dn.Offset(, 7)
            nRng.Offset(, 10) = nRng.Offset(, 10) + Dn.Offset(, 10)
            nRng.Offset(, 11) = nRng.Offset(, 11) + Dn.Offset(, 11)
           If Delrng Is Nothing Then Set Delrng = Dn Else Set Delrng = Union(Delrng, Dn)
        End If
     End If
    Next Dn
    If Not Delrng Is Nothing Then Delrng.EntireRow.Delete
    .ScreenUpdating = True
    End With
    End Sub
    Regards Mick

  4. #4
    New Member
    Join Date
    Aug 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    Quote Originally Posted by MickG View Post
    Try this:-
    Code:
    Sub MG11Aug53
    Dim Rng As Range, Dn As Range, nRng As Range, Delrng As Range
    Set Rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
    With Application
     .ScreenUpdating = False
    
    For Each Dn In Rng
      If .CountA(Dn.Offset(, 2).Resize(, 5)) = 0 And .CountA(Dn.Offset(, 8).Resize(, 2)) = 0 Then
        If nRng Is Nothing Then
            Set nRng = Dn
        Else
            nRng.Offset(, 7) = nRng.Offset(, 7) + Dn.Offset(, 7)
            nRng.Offset(, 10) = nRng.Offset(, 10) + Dn.Offset(, 10)
            nRng.Offset(, 11) = nRng.Offset(, 11) + Dn.Offset(, 11)
           If Delrng Is Nothing Then Set Delrng = Dn Else Set Delrng = Union(Delrng, Dn)
        End If
     End If
    Next Dn
    If Not Delrng Is Nothing Then Delrng.EntireRow.Delete
    .ScreenUpdating = True
    End With
    End Sub
    Regards Mick

    Thanks Mick- this worked great! What would I need to add to the code if I wanted to rename the consolidated row column A to "Consolidated Totals"?

  5. #5
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    If you mean as per your results sheet, then add line shown in Red
    Code:
    If nRng Is Nothing Then
            Set nRng = Dn
            nRng.Value = "Consolidated row"
        Else

  6. #6
    New Member
    Join Date
    Aug 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    Awesome- works like a charm.

  7. #7
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    You're welcome

  8. #8
    New Member
    Join Date
    Aug 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    I just realized that the consolidation macro deleted some of a different table on my spreadsheet. How would you limit the range in this function to only columns A:L?

  9. #9
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    Try this , its a different approach !!
    Code:
    Sub MG16Aug56
    Dim rng As Range, Dn As Range, Ac As Long
    Dim Ray As Variant, c As Long, n As Long
    Set rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
    ReDim Ray(1 To rng.Count, 1 To 12)
    With Application
    For Each Dn In rng
     
      If .CountA(Dn.Offset(, 2).Resize(, 5)) = 0 And .CountA(Dn.Offset(, 8).Resize(, 2)) = 0 Then
        If n = 0 Then
          c = c + 1
            n = c
            Ray(n, 1) = "Consolidated row"
            Ray(n, 8) = Dn.Offset(, 7)
            Ray(n, 11) = Dn.Offset(, 10)
            Ray(n, 12) = Dn.Offset(, 11)
        Else
            Ray(n, 8) = Ray(n, 8) + Dn.Offset(, 7)
            Ray(n, 11) = Ray(n, 11) + Dn.Offset(, 10)
            Ray(n, 12) = Ray(n, 12) + Dn.Offset(, 11)
        End If
     Else
       c = c + 1
      For Ac = 1 To 12
           Ray(c, Ac) = Dn.Offset(, Ac - 1)
       Next Ac
     End If
    Next Dn
    rng.Resize(, 12).ClearContents
    Range("A4").Resize(c, 12) = Ray
    End With
    End Sub
    Regards Mick

  10. #10
    New Member
    Join Date
    Aug 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Consolidate rows with a macro based on lack of value in certain columns

    Thank you- this worked. Where and how would I enter formatting instructions for the new last row?

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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