macro to combine product and sales

[sangsterexcell]

I am looking for a macro to combine my Stock #'s in column D along with the information in columns A,B,C and E. Along with that when column D is combined I need to add the sales totals in columns F, G and H so I have the totals of all those columns combined. I have 7000 lines of data to combine.

 

[mrmmickle1]

Can you please post an example of the way your data is set up (Before) ---> as well as an example of the end result you wish to achieve? (After)

 

[sangsterexcell]

current example:

A B C D E F G H
ace bat AA 1 FC1 6 3 18
ace bat AA 1 FC1 5 2 25
ace bat AA 1 FC1 1 5 63
ace cat BB 2 33 10 2 33
ace cat BB 2 33 5 5 18
ace cat BB 2 33 3 3 21
dues CV CC 3 15 6 9 19
dues CV CC 3 15 4 5 85
trey abc DD 4 A4 15 3 45
trey abc DD 4 A4 11 8 32
trey abc DD 4 A4 9 11 63
trey abc DD 4 A4 5 6 25

My answer should look like this:

A B C D E F G H
ace bat AA 1 FC1 12 10 106
ace cat BB 2 33 18 10 70
deus CV CC 3 15 10 14 104
and so on down the line

 

[mrmmickle1]

Probably a lot easier ways to do this but here's one way....

Before:

Excel 2012
	A	B	C	D	E	F	G	H	I
1	Header	Header	Header	Header	Header	Header	Header	Header	Helper Column
2	ace	bat	AA	1	FC1	6	3	18
3	ace	bat	AA	1	FC1	5	2	25
4	ace	bat	AA	1	FC1	1	5	63
5	ace	cat	BB	2	33	10	2	33
6	ace	cat	BB	2	33	5	5	18
7	ace	cat	BB	2	33	3	3	21
8	dues	CV	CC	3	15	6	9	19
9	dues	CV	CC	3	15	4	5	85
Sheet1

After:

Excel 2012
	A	B	C	D	E	F	G	H	I
1	Header	Header	Header	Header	Header	Header	Header	Header	Helper Column
2	ace	bat	AA	1	FC1	12	10	106
3	ace	cat	BB	2	33	18	10	72
4	dues	CV	CC	3	15	10	14	104
Sheet1

Try using this code on a copy of your workbook. Run the Sub AllTogether:

[COLOR=#0000ff]Sub[/COLOR] AllTogether()

Application.ScreenUpdating = [COLOR=#0000ff]False[/COLOR]
[COLOR=#0000ff]    Call[/COLOR] InsertRowBasedOnValue
   [COLOR=#0000ff] Call[/COLOR] InsertSums
    [COLOR=#0000ff]Call[/COLOR] DelRowBasedOnWord
Application.ScreenUpdating = [COLOR=#0000ff]True[/COLOR]

[COLOR=#0000ff]End Sub[/COLOR]

[COLOR=#0000ff]Sub[/COLOR] InsertSums()

[COLOR=#0000ff]    Dim [/COLOR]c       [COLOR=#0000ff] As[/COLOR] Range
 [COLOR=#0000ff]   Dim [/COLOR]ColArr()[COLOR=#0000ff] As[/COLOR] [COLOR=#0000ff]Variant[/COLOR]
    
    ColArr = Array("F", "G", "H")
   [COLOR=#008000] 'Inserts Sum By Groups based on blank cells ....i.e. SpecialCells[/COLOR]
 [COLOR=#0000ff]   For [/COLOR]ArrLp =[COLOR=#0000ff] LBound[/COLOR](ColArr)[COLOR=#0000ff] To UBound[/COLOR](ColArr)
    [COLOR=#0000ff]    For Each[/COLOR] c [COLOR=#0000ff]In [/COLOR]Range(ColArr(ArrLp) & ":" & ColArr(ArrLp)).SpecialCells(xlConstants).Areas
          [COLOR=#0000ff]  If [/COLOR]c(1).Row > 1 [COLOR=#0000ff]Then[/COLOR] c(0) = Application.WorksheetFunction.Sum(Range(c.Address))
      [COLOR=#0000ff]  Next[/COLOR] c
 [COLOR=#0000ff]   Next[/COLOR] ArrLp
    
[COLOR=#0000ff]End Sub[/COLOR]

[COLOR=#0000ff]Sub [/COLOR]InsertRowBasedOnValue()

[COLOR=#0000ff]Dim[/COLOR] lrow[COLOR=#0000ff] As Long[/COLOR]
[COLOR=#008000]'Insert New Blank Summary Row Based on if values in Column A, B, C match up
[/COLOR]
lrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("I2:I" & lrow) = "DeleteLater"

[COLOR=#0000ff]For[/COLOR] lrow = lrow[COLOR=#0000ff] To[/COLOR] 2 [COLOR=#0000ff]Step[/COLOR] -1
  [COLOR=#0000ff]  If [/COLOR]Cells(lrow, "A") & Cells(lrow, "B") & Cells(lrow, "C") <> _
        Cells(lrow - 1, "A") & Cells(lrow - 1, "B") & Cells(lrow - 1, "C") [COLOR=#0000ff]Then[/COLOR]
        Rows(lrow).EntireRow.Insert
      [COLOR=#008000]  'Insert Values in New Summary Row for Columns A - E[/COLOR]
        Cells(lrow, 1) = Cells(lrow + 1, 1)[COLOR=#008000] 'Column A[/COLOR]
        Cells(lrow, 2) = Cells(lrow + 1, 2) [COLOR=#008000]'Column B...etc[/COLOR]
        Cells(lrow, 3) = Cells(lrow + 1, 3)
        Cells(lrow, 4) = Cells(lrow + 1, 4)
        Cells(lrow, 5) = Cells(lrow + 1, 5)
        
[COLOR=#0000ff]    End If[/COLOR]
[COLOR=#0000ff]Next[/COLOR] lrow

[COLOR=#0000ff]End Sub[/COLOR]

[COLOR=#0000ff]Sub[/COLOR] DelRowBasedOnWord()

[COLOR=#0000ff]    Dim[/COLOR] lr [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] i  [COLOR=#0000ff]As Long[/COLOR]
    
    lr = Range("I" & Rows.Count).End(xlUp).Row
 [COLOR=#0000ff]   For[/COLOR] i = lr To 1[COLOR=#0000ff] Step[/COLOR] -1
       [COLOR=#0000ff] If[/COLOR] Range("I" & i).Value = "DeleteLater" [COLOR=#0000ff]Then[/COLOR] Rows(i).Delete
[COLOR=#0000ff]    Next [/COLOR]i
[COLOR=#0000ff]End Sub[/COLOR]

 

[sangsterexcell]

Thanks this worked.

 

[mrmmickle1]

I'm not positive but, I swear I have seen this issue on the board before. I'd be willing to bet the code could be a lot more succinct. Happy to help out, just the same though.

 

[Smitty]

Welcome to the Board!

Have you tried a Pivot Table:

Excel 2012
	A	B	C	D	E	F	G	H
3	A	B	C	E	Sum of D	Sum of F	Sum of G	Sum of H
4	ace	bat	AA	FC1	3	12	10	106
5		cat	BB	33	6	18	10	72
6	dues	CV	CC	15	6	10	14	104
7	trey	abc	DD	A4	16	40	28	165
8	Grand Total				31	80	62	447
Sheet3

HTH,

 

[sangsterexcell]

No never have. Don't know how they work so I will have to look those up.

 

[mrmmickle1]

Smitty,

That's probably the best way your right! Can't believe I didn't think of that first... Must have had something in my coffee that morning ahah

 

[Smitty]

No never have. Don't know how they work so I will have to look those up.

See: Guide to Excel Pivot Tables | Chandoo.org - Learn Microsoft Excel Online