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

rockthecasbah121

New Member
Joined
Aug 9, 2019
Messages
7
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.
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[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

New Member
Joined
Aug 9, 2019
Messages
7
Try this:-
Code:
[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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
If you mean as per your results sheet, then add line shown in Red
Code:
If nRng Is Nothing Then
        Set nRng = Dn
       [COLOR="#FF0000"] nRng.Value = "Consolidated row"
[/COLOR]    Else
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
You're welcome
 

rockthecasbah121

New Member
Joined
Aug 9, 2019
Messages
7
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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this , its a different approach !!
Code:
[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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,367
Messages
5,486,440
Members
407,547
Latest member
Sankarasrinivas

This Week's Hot Topics

Top