Macro to copy A1:d1 if Column A has total spend
I'll give you a couple sets so we're clear.
Vendor Category Option Spend
ABC 7
IBM Yes 6
MAC Yes 5
Total Spend 18
11
Vendor Category Option Spend
ABC 3
IBM Yes 4
MAC 6
Total Spend 13
4
Vendor Category Option Spend
ABC 2
TTW Yes 77
IBM 3
MAC Yes 4
Total Spend 86
81
Vendor Category Option Spend
"dd" wrote:
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
|