Help creating code to insert rows and sum up data.

[Mister H]

Hi All:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I am trying to create a macro that will do the following.
<o></o>
1) Begin in Cell F2 and move Down
2) Whenever the word changes in column F I need the following to happen
3) Insert 3 Rows (move the data Down) and then I need some totals
4) Cell D I need a formula COUNTA D2:D# (preferably BOLD and <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1:stockticker w:st="on">RED</st1:stockticker>)
5) Cell H I need SUM(H2:H#) (preferably BOLD and <st1:stockticker w:st="on">RED</st1:stockticker>)
6) I then need to go back to Column F and continue to do the same thing for the next word..

<o></o>
I am not sure if it makes it any simpler but currently the 3 words I am trying to sum up are:

<o></o>
Applied
Unapplied
Unidentified

<o></o>
Basically I need to know the dollar amount and Count of the Applied, Unapplied and Unidentified.

<o></o>
Any suggestions?

<o></o>
THANKS to anyone that can assist or at least get me headed in the right direction.
<o></o>
Take Care,
Mark

 

[texasalynn]

No not the best solution for on error. Not exactly sure where it is error out but suspect it is on the FIND. So you could have If statements for each section

If Appy <> 0 Then
MCC1 = Cells.Find("Applied", After:=ActiveCell, SearchDirection:=xlNext).Address(False, False)
MCC1 = Range(MCC1).Offset(Appy, 0).Activate
  ... other part of code
End If

Repeat that for each of the three sections

 

[VoG]

Hi Audrey. Take a look at the Area property, Example below

Sub sbttls()
Dim LastRow As Long, i As Long, aArea As Range
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
    If Range("A" & i).Value <> Range("A" & i - 1).Value Then
        Rows(i).Insert
    End If
Next i
For Each aArea In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas
    Cells(aArea.Row + aArea.Rows.Count, 2).Value = WorksheetFunction.Sum(Range(Cells(aArea.Row, 2), Cells(aArea.Row + aArea.Rows.Count - 1, 2)))
    Cells(aArea.Row + aArea.Rows.Count, 3).Value = WorksheetFunction.Sum(Range(Cells(aArea.Row, 3), Cells(aArea.Row + aArea.Rows.Count - 1, 3)))
Next aArea
End Sub

 

[texasalynn]

Thanks VoG I was not familiar with that one. I'll have to study it, but looks good

 

[Mister H]

Hi texasalynn:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
THANKS AGAIN for Everything. It seems to do everything I required. I have made some changes to add in a few things extra that I thought of and it ACTUALLY STILL WORKS <?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /><v:shapetype id=_x0000_t75 stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" oreferrelative="t" o:spt="75" coordsize="21600,21600"><v:stroke joinstyle="miter"></v:stroke><v:formulas><v:f eqn="if lineDrawn pixelLineWidth 0"></v:f><v:f eqn="sum @0 1 0"></v:f><v:f eqn="sum 0 0 @1"></v:f><v:f eqn="prod @2 1 2"></v:f><v:f eqn="prod @3 21600 pixelWidth"></v:f><v:f eqn="prod @3 21600 pixelHeight"></v:f><v:f eqn="sum @0 0 1"></v:f><v:f eqn="prod @6 1 2"></v:f><v:f eqn="prod @7 21600 pixelWidth"></v:f><v:f eqn="sum @8 21600 0"></v:f><v:f eqn="prod @7 21600 pixelHeight"></v:f><v:f eqn="sum @10 21600 0"></v:f></v:formulas><vath o:connecttype="rect" gradientshapeok="t" o:extrusionok="f"></vath><o:lock aspectratio="t" v:ext="edit"></o:lock></v:shapetype>.

I inserted names for the different types of Receipts and then I added a formula to show if it is balanced or not (just n case my other macro deletes something it shouldn't. Anyway, I am posting the code just so anyone else that may look later requires anything similar.

[FONT=Verdana][COLOR=black][COLOR=black][FONT=Verdana]Sub AddTotals()[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]'This macro will seperate the Receipt Types and then Add the Subtoatals (BOLD & Red Font)[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Dim LR As Long, i As Long[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]Dim x As String, y As String, z As String[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]For i = LR To 3 Step -1[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Status = Cells(i, "F")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   If Cells(i, "F") <> Cells(i + 1, "F") And Cells(i + 1, "F") <> "" Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]               Rows(i + 1 & ":" & i + 3).Insert Shift:=xlDown[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Next i[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]LR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row + 1[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]               Rows(LR & ":" & LR + 2).Insert Shift:=xlDown[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Appy = WorksheetFunction.CountIf(Range("F:F"), "Applied")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]UnAp = WorksheetFunction.CountIf(Range("F:F"), "Unapplied")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Unid = WorksheetFunction.CountIf(Range("F:F"), "Unidentified")[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]'This will prevent an error if there are no Applied Receipts[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]If Appy <> 0 Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]MCC1 = Cells.Find("Applied", After:=ActiveCell, SearchDirection:=xlNext).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]MCC1 = Range(MCC1).Offset(Appy, 0).Activate[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       'Add the Subtotals (Red Font and BOLDED)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       x = ActiveCell.Offset(1, 2).End(xlUp).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       y = ActiveCell.Offset(-Appy, 2).Address(False, False)[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2) = "=SUBTOTAL(9," & x & ":" & y & ")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2).Font.ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2).Font.Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveWorkbook.Names.Add Name:="Applied", RefersToR1C1:=ActiveCell.Offset(0, 2)[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2) = "=SUBTOTAL(3," & x & ":" & y & ")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2).Font.ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2).Font.Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End If[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]'This will prevent an error if there are no Unapplied Receipts[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]If UnAp <> 0 Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]MCC2 = Cells.Find("Unapplied", After:=ActiveCell, SearchDirection:=xlNext).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]MCC2 = Range(MCC2).Offset(UnAp, 0).Activate[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]       'Add the Subtotals (Red Font and BOLDED)[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]       x = ActiveCell.Offset(1, 2).End(xlUp).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       y = ActiveCell.Offset(-UnAp, 2).Address(False, False)[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2) = "=SUBTOTAL(9," & x & ":" & y & ")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2).Font.ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2).Font.Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveWorkbook.Names.Add Name:="Unapplied", RefersToR1C1:=ActiveCell.Offset(0, 2)[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2) = "=SUBTOTAL(3," & x & ":" & y & ")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2).Font.ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2).Font.Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End If[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]'This will prevent an error if there are no Unidentified Receipts[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]If Unid <> 0 Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]MCC3 = Cells.Find("Unidentified", After:=ActiveCell, SearchDirection:=xlNext).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]MCC3 = Range(MCC3).Offset(Unid, 0).Activate[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       'Add the Subtotals (Red Font and BOLDED)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       x = ActiveCell.Offset(1, 2).End(xlUp).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       y = ActiveCell.Offset(-Unid, 2).Address(False, False)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2) = "=SUBTOTAL(9," & x & ":" & y & ")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2).Font.ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, 2).Font.Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveWorkbook.Names.Add Name:="Unidentified", RefersToR1C1:=ActiveCell.Offset(0, 2)[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2) = "=SUBTOTAL(3," & x & ":" & y & ")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2).Font.ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       ActiveCell.Offset(0, -2).Font.Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End If[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]'Find the Totals row[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Cells.Find(What:="Total for Batch", After:=ActiveCell, LookIn:=xlFormulas _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       MatchCase:=False, SearchFormat:=False).Activate[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]'Name the cell Totals[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]ActiveWorkbook.Names.Add Name:="Totals", RefersToR1C1:=ActiveCell.Offset(0, 7)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]'Add formula to ADD up Applied,Unapplied and Unidentified Receipts[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]ActiveCell.Offset(3, 7).FormulaR1C1 = "=IF(Applied+Unapplied+Unidentified-Totals<>0,""Not Balanced"",""Balanced"")"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]ActiveCell.Offset(3, 7).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       Formula1:="=""Not Balanced"""[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   With ActiveCell.Offset(3, 7).FormatConditions(1).Font[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .Italic = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .ColorIndex = 3[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   End With[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]   ActiveCell.Offset(3, 7).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       Formula1:="=""Balanced"""[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   With ActiveCell.Offset(3, 7).FormatConditions(2).Font[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .Bold = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .Italic = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .ColorIndex = 43[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]'Center cell contents[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   With ActiveCell.Offset(3, 7)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .HorizontalAlignment = xlCenter[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .VerticalAlignment = xlBottom[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .WrapText = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .Orientation = 0[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .AddIndent = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .IndentLevel = 0[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .ShrinkToFit = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .ReadingOrder = xlContext[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       .MergeCells = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub<o:p></o:p>[/COLOR][/FONT]
[/COLOR][/FONT]

<o></o>
VoG: THANKS for your input as well. Your code is much shorter but since this ones seems to be working I won't mess with it <o></o>
<o></o>
Have a GREAT night <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1:stockticker w:st="on">ALL</st1:stockticker>,<o></o>
Mark
<o></o>