Macro to copy A1:d1 if Column A has total spend
It doesn't work. When Column C had no value, it still gave me a subtotal
(random number). What if I changed the "Yes" to any value like "*".
"StumpedAgain" wrote:
I see my problem. I didn't reset r = 0 each time I started the loop over.
The following should be all fixed. Let me know if it doesn't work!
-SA
Option Explicit
Sub Copy_Headers()
Dim i, m As Integer, r As Long
Range("A1").Select
Do
If ActiveCell.Offset(1, 0) = "" Then Exit Do
r = 0
With ActiveCell
m = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With
If ActiveCell.End(xlDown).Value Like "Total Spend*" Then
Range("A1:D1").Copy ActiveCell.End(xlDown).Offset(2, 0)
ActiveCell.End(xlDown).Offset(0, 3) =
Application.Sum(Range(ActiveCell.Offset(1, 3),
ActiveCell.End(xlDown).Offset(-1, 3)))
For i = 0 To m
If ActiveCell.Offset(i, 2).Value Like "Yes" Then r = r +
ActiveCell.Offset(i, 3).Value
Next i
ActiveCell.End(xlDown).Offset(1, 3) = r
End If
ActiveCell.End(xlDown).Offset(2, 0).Select
Loop
End Sub
"dd" wrote:
I added the new macro but the sum is coming up with random numbers.
I think the best way for now would be copying the formula =if(c1="","",D1)
in column E and then use your previous macro to subtotal the column E and
insert in in Column D. Thank you for all your help. I'm not asking anymore
questions on this. I'll try to fiqure it out later. Thanks again.
Option Explicit
Sub Copy_Headers()
Range("A1").Select
Do
If ActiveCell.End(xlDown).Value Like "Total Spend*" Then
Range("A1:D1").Copy ActiveCell.End(xlDown).Offset(2, 0)
ActiveCell.End(xlDown).Offset(0, 2) =
Application.Sum(Range(ActiveCell.Offset(1, 2),
ActiveCell.End(xlDown).Offset(-1, 2)))
Else: Exit Do
End If
ActiveCell.End(xlDown).Offset(2, 0).Select
Loop
End Sub
|