Macro to copy A1:d1 if Column A has total spend

[dd]

Hi,
Theres four columns of data A.
If Column A has "Total Spend ", copy header A11 and paste it on the second
row below Total Spend. So for example,

A1 B1 C1 D1
Vendor Category Option Spend
ABC
IBM
MAC
Total Spend
(Blank Row)
Automatically Paste Vendor Category Option Spend
Sample Vendor1
Sample Vendor2
Sample Vendor3
Total Spend

Vendor Category Option Spend



Any help is appreciated. Thank you

 

[Jarek Kujawa]

select yr data and use the following macro:

Sub kopiuj()
For Each cell in Selection
If cell.Text = "Total Spend" Then
Range("A11").Copy cell.Offset(2,0)
End If
Next cell
End Sub


I hope you don't store any data in any of the cells that 2 rows below
"Total Spend"

 

[StumpedAgain]

Should do the trick unless there's more to it. Hope it helps!

Option Explicit
Sub Copy_Headers()

Range("A1").Select

Do
If ActiveCell.End(xlDown).Value = "Total Spend" Then
Range("A11").Copy ActiveCell.End(xlDown).Offset(2, 0)
Else: Exit Do
End If

ActiveCell.End(xlDown).Offset(2, 0).Select

Loop

End Sub

 

[dd]

Thanks StumpedAgain!
I have two more questions.

Is there a way to changed the "Total Spend" to Total Spend - anything?
Example, if the word was Total Spend - Apple or Total Spend - Cars?

Also is it possible to subtotal the column C for each cluster before the
header row? For example,

Vendor Category Option Spend
ABC Computer 50 1000
IBM Computer 3000
MAC Computer 9 2000
Total Spend - Computer 59 6000

Vendor Category Option Spend
1 Any 5 100
2 Any 0
3 Any 1 10
Total Spend - Any 6 110

 

[StumpedAgain]

The following covers both questoins. (mind the wrapping) I had to use like
and a "*" for your first request. This program allows for different number
of rows in each section. Hope it helps! Let me know if there's anything
else.

-SA

Option Explicit
Sub Copy_Headers()

Range("A1").Select

Do
If ActiveCell.End(xlDown).Value Like "Total Spend*" Then
Range("A11").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

 

[dd]

Thanks for the fast response. You solved my first question but I made a
mistake in asking my second question.
Under Column C, basically says Yes or the cell is blank and column D has the
spend amount. What I wanted to do was to subtotal the Spend amount in Column
D when there is Yes in Col C and the subtotal for the Column C would be
displayed under the total spend row in Column D. I appologize if this sounds
confusing. Thanks so much.

Vendor Category Option Spend
ABC Computer Yes 1000
IBM Computer 3000
MAC Computer Yes 2000
Total Spend - Computer 6000
3000
(so $3000 is displayed Col D)

 

[StumpedAgain]

What is this a test? These questions keep evolving and getting more and more
involved!

The following should do the trick. I had to change the exit point and
define some variables. Let me know if there's any more changes. (mind the
wrapping again)

-SA

Option Explicit
Sub Copy_Headers()

Dim i, m As Integer, r As Long

Range("A1").Select
r = 0

Do
If ActiveCell.Offset(1, 0) = "" Then Exit Do
With ActiveCell
m = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With
If ActiveCell.End(xlDown).Value Like "Total Spend*" Then
Range("A11").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]

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.

 

[StumpedAgain]

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("A11").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]

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]

OK, so it's working on what I have set up. Does what's here look like what
you want? I will be afk for the rest of the day, but I will look back here
tonight or tomorrow if you haven't figured it out. Good luck!

What I have:

Vendor Category Option Spend
ABC 2
TTW Yes 77
IBM 3
MAC Yes 4
Total Spend 86
81

 

[StumpedAgain]

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]

I took out the total spend formula because I already have the total spend and
moved the options total up one cell. So now it works half way, the other half
is what if under column C, it's not Yes and another value or text. Can we
create a formula that will add up the spend in column D as long as somthing
is enter in Column C?

Thanks again.


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("A11").Copy ActiveCell.End(xlDown).Offset(2, 0)

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(0, 3) = r
End If

ActiveCell.End(xlDown).Offset(2, 0).Select

Loop

End Sub

 

[dd]

Thanks StumpedAgain for all your hard work!
I figured it out.

 

[StumpedAgain]

I'd say the easiest way is to substitute

If ActiveCell.Offset(i, 2).Value Like "Yes" Then r = r +
ActiveCell.Offset(i, 3).Value

with

If ActiveCell.Offset(i, 2).Value <> "" Then r = r +
ActiveCell.Offset(i, 3).Value

you'll also have to change

For i = 0 To m

to

For i = 1 To m

Let me know how it goes!

-SA

 

[dd]

I just saw your message below after I posted, this works also.
Thanks again.