Macro to Duplicate Specifically named Columns and Rename them as a date

Faintkitara

Board Regular
Joined
Jun 23, 2016
Messages
59
Hello,

I'm trying to figure out how to make a macro that copies all columns named " Current Projection" in row 4 and pastes them right after each other. So wherever a column says "Current Projection" in row 4 i pretty much want that column to be duplicated. I tried doing this myself but of course macrorecorder can only go so far. For example row 4 would look like this (with corresponding data below it):

5/55/12Current ProjectionAccountsCurrent ProjectionTotals

<tbody>
</tbody>

I want it to look like this:

5/55/12Current Projection Current ProjectionAccountsCurrent ProjectionCurrent Projection Totals

<tbody>
</tbody>



On top of that I also wanted to get code on how to rename every first "Current Projection" column of the duplicates, a date that is seven days more than the date listed the column before it.

So from this:

5/55/12Current ProjectionCurrent ProjectionAccounts 7/27/9Current ProjectionCurrent ProjectionTotals

<tbody>
</tbody>

To this:

5/55/125/19Current ProjectionCurrent ProjectionAccounts7/27/97/16Current Projection

<tbody>
</tbody>


Any response would be greatly appreciated! Thank you!!!
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sorry the Last example should NOT have two "Current Projection" cells. Only one, didnt know how to edit my previous post
 
Upvote 0
In your first example
5/5
5/12Current ProjectionAccountsCurrent Projection
Totals

<tbody>
</tbody>

there is no date on the left of the second "Current Projection" is it possible, do we need to check if a date exists ?
 
Upvote 0
In your first example
5/5
5/12Current ProjectionAccountsCurrent ProjectionTotals

<tbody>
</tbody>

there is no date on the left of the second "Current Projection" is it possible, do we need to check if a date exists ?

Well, this is just an example, but there could be dates on the left and there may not be (i would suggest that you check)
 
Upvote 0
Try
Code:
Option Explicit

Sub Treat()
Const WkRow  As Integer = 4
Const WkW As String = "Current Projection"
Const NbD  As Integer = 7
Dim LC  As Integer, J As Integer


   LC = Cells(WkRow, Columns.Count).End(xlToLeft).Column
   For J = LC To 1 Step -1
      If (Cells(WkRow, J) = WkW) Then
         Columns(J).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         If (IsDate(Cells(WkRow, J - 1))) Then
            Cells(WkRow, J) = Cells(WkRow, J - 1) + NbD
         Else
            Cells(WkRow, J) = WkW
         End If
      End If
   Next
End Sub
 
Upvote 0
This is greaat! You are brilliant sir!

I did hit a snag though. The column "Current Projection" is copied and the name is changed to the date but the data listed below it is not copied. Under neath the column it completely blank. Is there something in the code that can be slightly changed? I will try to see what the error is on my own as well.
 
Upvote 0
See next code
Code:
Option Explicit

Sub Treat()
Const WkRow  As Integer = 4
Const WkW As String = "Current Projection"
Const NbD  As Integer = 7
Dim LC  As Integer, J As Integer
Dim LR  As Integer

   LC = Cells(WkRow, Columns.Count).End(xlToLeft).Column
   For J = LC To 1 Step -1
      If (Cells(WkRow, J) = WkW) Then
         Columns(J).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         If (IsDate(Cells(WkRow, J - 1))) Then
            LR = Cells(Rows.Count, J - 1).End(3).Row
            With Range(Cells(WkRow, J), Cells(LR, J))
               .Cells.Formula = "=RC[-1]+" & NbD
               .Value = .Value
            End With
         Else
            Cells(WkRow, J) = WkW
         End If
      End If
   Next
End Sub
 
Upvote 0
This is great thanks! One more tiny request. How can I change it to where I copy the value instead of the formula when duplicating the column. And what Can I input into the code to make it to where the formatting is clear for the duplicate columns as well. I promise this is it lol (wish I could you points or likes or something)
 
Upvote 0
"I copy the value instead of the formula when duplicating the column. And what"
The macro is using a formula to copy the date (to be sure there is 7 days difference what ever the date) but at the end values are frozen : no more formulas ....!
"the formatting is clear for the duplicate columns"
The format for duplicated columns is the same that the one on the left: To reuse date format
=> from where do you want the format coming from ???
 
Upvote 0
After looking closer at the data, I realized that the macro is adding 7 units onto the copied date as well as the data instead of just adding 7 units to the date and leaving the data alone.

And ok, I get what you are saying about the clear formatting.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,216,752
Messages
6,132,512
Members
449,731
Latest member
dasda34

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top