Excel Macro VBA Help Needed

M

mrtaylor1313

I have a sheet which has been copied from a pivot table. I need it to
perform the following:

Find a cell with specific text (Yes)
Move over three columns (I have been using an offset)
Write a formula that subtotals data that is below this summation row
Copies this formula to right until the column is empty
Display this data onto a new summary sheet


Ultimately, this would be a loop that looks in column C for some
wildcard, subtotals and then, moves over to column B and totals the
previously calc'd subtotals.


I seem to be able to get to the specific text cell and use the offset.
I am struggling with the formula as the rows that the formulas or
subtotals would be on are never the same row #'s. If the source data
that I copied were from an original formula-based spreadsheet, this
would be easier for me.


Any help would be appreciated greatly.
 
G

Guest

Write a formula that subtotals data that is below this summation row

where is the data to be summed in relation to the text containing the
searched for text?

Is the sum from the row after this row down to the next empty cell.

Assume the found text is in C3 and we are in F3. the numbers to sum are in
D4:D20 and D21 is blank

set rng = cells.find("ABC")
' rng is a reference to C3
set rng1 = rng.offset(0,3)
set rng2 = rng.offset(1,1)
rng1.formula = "=Sum(" & range(rng2,rng2.end(xldown)).Address(1,1) & ")"
 
M

mrtaylor1313

Thank you for your quick answer.

The data to be summed would be directly below the sum formula so I
could modify the code that you have written to meet this.

However, when I copy from a pivot table, I do not have a static number
of cells to sum and I would have subtotals in the data. I am trying to
avoid having to insert rows after every sub category.
 
G

Guest

set rng = cells.find("ABC")
' rng is a reference to C3
set rng1 = rng.offset(0,3)
set rng2 = rng1.offset(1,0)
set rng3 = range(rng2,rng2.end(xldown)).Specialcells(xlConstants,xlNumbers)
rng1.formula = "=Sum(" & rng3.Areas(1).Address(1,1) & ")"
 
M

mrtaylor1313

I am getting a cells not found error on the set rng 3 line?? Below is
an example of the spreadsheet. Exp. Onetime and Exp. Ong. would be
sums in Col. E (of the data below it). Col. B would then be a
summation of the subtotals. I am using a find to get to the exp. lines
and then, the offset to get over to Col. E.

Col. B Col. C Col. D Col. E

Yes 610,781
EXPENSE ONETIME 454,856
CONTRACT LABOR 205,967
OTHER DIRECT 140,146
EXPENSE ONGOING 155,924
EQUIPMENT DEPR 41,446
OTHER EQUIPMENT 114,479
 
M

mrtaylor1313

Well, I could not get to the answer that I needed using the above
advice so I thought I would try a differenct tactic.

I need to sum a range of #'s that will vary in size. I would want the
macro to find the Yes in Col. B and then, move down to the Col. D
(ignoring the subtotals from the Col. C categories) subcategories
(contract labor, etc.) and sum up these lines for 12 columns (12
months). I would then, need to skip other the second category (Expense
Ongoing) and sum up the subcategories (equip. depr, etc.)

Any ideas?
 
G

Guest

send me some actual sample data in a workbook and color the cells where you
want a subtotal in blue and the cells to subtotal in red.

Indicate in green where you want the summary of the subtotals.

(e-mail address removed)
 
T

Tom Ogilvy

Sub BuildFormulas()
Dim oldAr As Range, rng As Range, lastRow As Range
Dim icol As Range, rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim ar As Range, ar1 As Range
Set rng = Range(Cells(4, "D"), Cells(Rows.Count, "D").End(xlUp))
Set lastRow = rng(rng.Count).Offset(1, 0)
Set rng1 = rng.SpecialCells(xlConstants)

' determine extent of the data
Set rng2 = Range(rng1.Areas(1)(1, 2), rng1.Areas(1)(1, 2).End(xlToRight))
Set icol = Columns(rng2(1).Column).EntireColumn
For Each ar In rng1.Areas
Set ar1 = Intersect(ar.EntireRow, icol)
ar1.Offset(-1, 0).Resize(1, rng2.Columns.Count).Formula = _
"=Subtotal(9," & ar1.Address(1, 0) & ")"
Next
Set rng1 = rng.Offset(0, -2).SpecialCells(xlConstants)
Set rng1 = Union(rng1, Intersect(lastRow.EntireRow, _
rng1.EntireColumn))
For Each ar In rng1.Areas
If ar.Address <> rng1.Areas(1).Address Then
Set rng3 = Range(oldAr(2), ar(1)(0))
Set rng3 = Intersect(rng3.EntireRow, icol)
oldAr.Offset(0, 3).Resize(1, rng2.Columns.Count).Formula = _
"=Subtotal(9," & rng3.Address(1, 0) & ")"
End If
Set oldAr = ar
Next
Set ar = Intersect(lastRow.EntireRow, Columns(1))
Set oldAr = Cells(4, "A")
Set rng3 = Range(oldAr(2), ar(1)(0))
Set rng3 = Intersect(rng3.EntireRow, icol)
oldAr.Offset(0, 4).Resize(1, rng2.Columns.Count).Formula = _
"=Subtotal(9," & rng3.Address(1, 0) & ")"

Set rng4 = Columns(2).Find("Yes")

With lastRow.Offset(1, 1)
.Value = "Q1"
.Font.Bold = True
.Offset(1, 0).Formula = _
Application.Substitute("=Sum(E4:G4)", 4, rng4.Row)
With .Offset(0, 3)
.Value = "Q2"
.Font.Bold = True
.Offset(1, 0).Formula = _
Application.Substitute("=Sum(H4:J4)", 4, rng4.Row)
End With
End With


End Sub
 
M

mrtaylor1313

Tom,

Thank you tremendously! Everything worked great on the test
spreadsheet. I have one issue when I have converted it to the actual
spreadsheet.

Application.Substitute("=Sum(E4:G4)", 4, rng4.Row)

This line seems to be static however, rng4.Row is dynamic. How can I
modify the sum(E4:G4) to mirror the Find in rng4? As an example, if the
Find function returns row 62, it would update the cell row in the sum
accordingly (E62:G62)?

Again, thank you!

Rusty
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top