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

[rockthecasbah121]

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.

 

[rockthecasbah121]

Just realized I can't post attachments I guess.

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

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

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG11Aug53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range, Delrng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] Application
 .ScreenUpdating = False

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
  [COLOR="Navy"]If[/COLOR] .CountA(Dn.Offset(, 2).Resize(, 5)) = 0 And .CountA(Dn.Offset(, 8).Resize(, 2)) = 0 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Dn
    [COLOR="Navy"]Else[/COLOR]
        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)
       [COLOR="Navy"]If[/COLOR] Delrng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Delrng = Dn Else [COLOR="Navy"]Set[/COLOR] Delrng = Union(Delrng, Dn)
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] Not Delrng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] Delrng.EntireRow.Delete
.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[rockthecasbah121]

Try this:-

[COLOR=Navy]Sub[/COLOR] MG11Aug53
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, nRng [COLOR=Navy]As[/COLOR] Range, Delrng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] Application
 .ScreenUpdating = False

[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
  [COLOR=Navy]If[/COLOR] .CountA(Dn.Offset(, 2).Resize(, 5)) = 0 And .CountA(Dn.Offset(, 8).Resize(, 2)) = 0 [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]Set[/COLOR] nRng = Dn
    [COLOR=Navy]Else[/COLOR]
        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)
       [COLOR=Navy]If[/COLOR] Delrng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] Delrng = Dn Else [COLOR=Navy]Set[/COLOR] Delrng = Union(Delrng, Dn)
    [COLOR=Navy]End[/COLOR] If
 [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]If[/COLOR] Not Delrng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] Delrng.EntireRow.Delete
.ScreenUpdating = True
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

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"?

 

[MickG]

If you mean as per your results sheet, then add line shown in Red

If nRng Is Nothing Then
        Set nRng = Dn
       [COLOR="#FF0000"] nRng.Value = "Consolidated row"
[/COLOR]    Else

 

[rockthecasbah121]

Awesome- works like a charm.

 

[MickG]

You're welcome

 

[rockthecasbah121]

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?

 

[MickG]

Try this , its a different approach !!

[COLOR="Navy"]Sub[/COLOR] MG16Aug56
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] rng = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To rng.Count, 1 To 12)
[COLOR="Navy"]With[/COLOR] Application
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] rng
 
  [COLOR="Navy"]If[/COLOR] .CountA(Dn.Offset(, 2).Resize(, 5)) = 0 And .CountA(Dn.Offset(, 8).Resize(, 2)) = 0 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] n = 0 [COLOR="Navy"]Then[/COLOR]
      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)
    [COLOR="Navy"]Else[/COLOR]
        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)
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Else[/COLOR]
   c = c + 1
  [COLOR="Navy"]For[/COLOR] Ac = 1 To 12
       Ray(c, Ac) = Dn.Offset(, Ac - 1)
   [COLOR="Navy"]Next[/COLOR] Ac
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
rng.Resize(, 12).ClearContents
Range("A4").Resize(c, 12) = Ray
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[rockthecasbah121]

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