Place formula in cells

[pmxgs]

Hi,

Can someone please help me how to write this procedure.
I'm just beginning to learn vba so I don't know which methods and
properties to use.
What I want to do is this:
Go through every row (3 until 150) on column A and if the character "*"
(asterisk) is found in each of these rows then write the following formulas
on each column. ex: sum(b3:b15),sum(c3:c15)....sum(h3:h15) assuming that the
asterisk is found on row 15.
Then start looking for an asterisk again and when it is found write the same
formulas , but this time the sum will only include the rows that were not
included previoulsy.ex: sum(b16:b28),sum(c16:c28)....sum(h16:h28) (I'm
assuming the asterisk is found on row 28).
The sum has to be written in every row which has an asterisk, the formula is
repeated in every column from B to H.
thanks

 

[Joel]

I write this code all the time. Most people want a blank row added after the
totals. You mae it a little easier than most people by putting the * in
colunn A.


StartRow = 3
RowCount = StartRow
Do While Range("A" & RowCount) <> ""
If Range("A" & RowCount) = "*" Then
Range("B" & RowCount).Formula = _
"=SUM(B" & StartRow & ":B" & RowCount & ")"
Range("B" & RowCount).Copy _
Destination:=Range("B" & RowCount & ":H" & RowCount)
StartRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop

 

[Don Guillett]

try
Sub SumRangesIf()
sr = 2
With Range("a1:a500")
Set c = .Find("~*", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
mr = c.Row

For i = 1 To 7
c.Offset(, i) = Application.Sum(Range(Cells(sr, i + 1), Cells(mr - 1, i
+ 1)))
Next i

sr = mr + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress

End If
End With

End Sub

 

[Don Guillett]

One small amendment
"=SUM(B" & StartRow & ":B" & RowCount & ")"
to
"=SUM(B" & StartRow & ":B" & RowCount - 1 & ")"

 

[pmxgs]

Thanks for your prompt reply.
I copy pasted your code and ran this procedure but nothing happened.
I don't know what I'm doing wrong.
Just for confirmation, when I said "*" I litterally mean the asterisk
character, not any character.

thanks

 

[pmxgs]

Hi,

thanks very much for your help.
It's doing what I want except for one thing.
This procedure is summing the correct rows but leaves the resulting
calculation as values, and I need to have the actual sum function in those
cells (the built in sum worksheet function), as if I typed directly in the
cells "=Sum(b3:b15)"

 

[Don Guillett]

Joel's, as amended, is looking for ONLY * whereas mine will find any of
these because it is looking for PART. You should always FULLY state your
problem in the OP.

a*a
a
a
a
a
aa*
a
a
*aa

*

 

[Don Guillett]

One way combining posts

Sub makeforulasifFormula() 'Me
sr = 2
With Range("a1:a500")
Set c = .Find("~*", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
mr = c.Row
'one formula
c.Offset(, 1).Formula = "=sum(b" & sr & ":b" & mr - 1 & ")"
Range("B" & mr).Copy Range("B" & mr & ":H" & mr)
sr = mr + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Sub

 

[pmxgs]

It's exactly what I wanted.

Thanks everyone.

One way combining posts

Sub makeforulasifFormula() 'Me
sr = 2
With Range("a1:a500")
Set c = .Find("~*", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
mr = c.Row
'one formula
c.Offset(, 1).Formula = "=sum(b" & sr & ":b" & mr - 1 & ")"
Range("B" & mr).Copy Range("B" & mr & ":H" & mr)
sr = mr + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

 

[Don Guillett]

Glad we were able to help. I usually prefer to just leave the values and
refresh as desired instead of calculating when not necessary and leaving the
formulas for users to change or delete. My original could be tied to a
worksheet_change event if desired.