Macro to copy the format of a chosen named range to another fixed point

[FrankLinssen]

I have a field called period with the variables 1 to 13. In the file I have a dropdownlist where the user can select a period. Each period is linked to a named range.
Like this:

When the user selected e.g. 6 as the period the range tb_per_202406 is pulled in to a certain cell. I am using the following formula for that: =TAKE(INDIRECT(VLOOKUP(T1,$Q$2:$R$14,2,0)),1000,5)

All this works perfectly. Now the challenge is as follows. Each named range has a certain formatting (also different for each range).
I also want to pull in (read "copy") the formatting of the selected period (= range). But as far as I know Excel cannot do that. So I was thinking of using VBA for this.
Basically what I want is that the macro is copying the format of the chosen range (via the selected period) and then go to a certain cell (named as "startcell") and have the format pasted to that cell?

I hope my question is clear?
PS using Office 365

 

[DanteAmor]

Hi @FrankLinssen

Put the following code in the sheet events where you want this to work.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) = "T1" Then
    If Target.Value = "" Then Exit Sub
 
    Dim f As Range, a_cell As String
 
    Set f = Range("Q2:Q14").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      Application.ScreenUpdating = False
      a_cell = ActiveCell.Address
      f.Offset(0, 1).Copy
      Range("startcell").PasteSpecial Paste:=xlPasteFormats
      Range(a_cell).Activate
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
    End If
  End If
End Sub

Note Sheet Event:

Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.​

How the code works. Every time you change the number in cell T1, the code is automatically executed and will change the format of the cell named "startcell"

Note 2:

PS using Office 365

You can update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using. (Don’t forget to scroll down & ‘Save’)​

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[FrankLinssen]

Hi @FrankLinssen

Put the following code in the sheet events where you want this to work.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) = "T1" Then
    If Target.Value = "" Then Exit Sub
 
    Dim f As Range, a_cell As String
 
    Set f = Range("Q2:Q14").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      Application.ScreenUpdating = False
      a_cell = ActiveCell.Address
      f.Offset(0, 1).Copy
      Range("startcell").PasteSpecial Paste:=xlPasteFormats
      Range(a_cell).Activate
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
    End If
  End If
End Sub

Note Sheet Event:

Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.​

How the code works. Every time you change the number in cell T1, the code is automatically executed and will change the format of the cell named "startcell"

Note 2:

You can update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using. (Don’t forget to scroll down & ‘Save’)​

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Dante, thanks.
I entered the code as you wrote above. But somehow, when I change the value in cell T1, nothing changes. Does it matter that the named ranges are not in this sheet but in the next one?
Also how is this code different then a macro? And if I want the same thing setup as a macro, how to do that?
Regards.

 

[DanteAmor]

Try whit this code.
Change in the code "Sheet2" to the name of the sheet where the data is located.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) = "T1" Then
    If Target.Value = "" Then Exit Sub
 
    Dim f As Range, a_cell As String
   
    Set f = Sheets("Sheet2").Range("Q2:Q14").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      Application.ScreenUpdating = False
      a_cell = ActiveCell.Address
      f.Offset(0, 1).Copy
      Range("startcell").PasteSpecial Paste:=xlPasteFormats
      Range(a_cell).Activate
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
    End If
  End If
End Sub

The difference between code in an event and code in a macro is that the event is triggered automatically and you will have to execute the code in the macro.

I'll give you the macro, so you will have the 2 codes and you can see the difference.
Note: Change in the code "Sheet2" to the name of the sheet where the data is located.

Sub copycolor()
  Dim f As Range, a_cell As String
 
  Set f = Sheets("Sheet2").Range("Q2:Q14").Find(Range("T1").Value, , xlValues, xlWhole)
  If Not f Is Nothing Then
    f.Offset(0, 1).Copy
    Range("startcell").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
  End If
End Sub

----- --
If you have difficulties, then explain in more detail what the sheets are called and where the data is.
Respectfully
Dante Amor
----- --

 

[FrankLinssen]

Sub copycolor() Dim f As Range, a_cell As String Set f = Sheets("Sheet2").Range("Q2:Q14").Find(Range("T1").Value, , xlValues, xlWhole) If Not f Is Nothing Then f.Offset(0, 1).Copy Range("startcell").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End If End Sub

Thanks Dante for your efforts.
It is still not working. Let me try to explain better.
One sheet has the 13 ranges with data including the proper format per range. Nameof the sheet: Data_plus_Format
On another sheet I am pulling in the data (only) based on the selected range. So e.g. period 1 = tb_per_202401
e.g. period 5 = tb_per_202405 via the formula I mentioned before: =TAKE(INDIRECT(VLOOKUP(T1,$Q$2:$R$14,2,0)),1000,5) Let's say this sheet is called SelectedRange.
On this same sheet I have also sitting the table I showed above with Period and Range.

So what i want is the macro to do a kind of vlookup based on the selected period (a nr between 1 and 13) and based on that number go to the related range, copy the format from there and paste the format to cell called startcell. This "startcell" is also the 1st cell of the range that I am pulling in with the take formula (basically that formula is in cell "startcell" which makes sense as that is the first cell of the area where the format should be pasted to.
Hope this is more clear now.
Thanks again.

 

[DanteAmor]

What you explain is what macros do.

So something is not clear to me.

Could you explain it with images.

You must ensure that the names of the sheets and the names of the ranges are visible in your images.
For example:

Explain with several images, before the macro, and how you want the result after running the macro.

 

[DanteAmor]

If you have difficulty explaining it with images.
Then you can share your file. I am not interested in seeing your data, what I am interested in is knowing where you capture the period, where the table with the 13 periods is, where the named ranges are and of course, where the format to copy is and where you want to paste that format.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[FrankLinssen]

If you have difficulty explaining it with images.
Then you can share your file. I am not interested in seeing your data, what I am interested in is knowing where you capture the period, where the table with the 13 periods is, where the named ranges are and of course, where the format to copy is and where you want to paste that format.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Hi Dante,
Try this link: Dropbox

 

[DanteAmor]

Hi @FrankLinssen, Thanks for sharing the file. Now it's clear.

I show you 3 options:

1. The macro as you want it. You change the period in T1 and run the following macro:

Sub copycolor_v2()
  Dim f As Range
 
  Set f = Range("Q2:Q14").Find(Range("T1").Value, , xlValues, xlWhole)
  If Not f Is Nothing Then
    Application.ScreenUpdating = False
    Range("startcell").Resize(1000, 5).ClearFormats
    Sheets("hardcoded formatted data 13per.").Range(f.Offset(0, 1).Value).Copy
    Range("startcell").PasteSpecial Paste:=xlPasteFormats
    Range("T1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
  End If
End Sub

2. With the following macro, the Take(Indirect...) formula is not necessary.
You change the period in T1 and run the following macro:

Since the macro will copy data and formats, this way will work for your versions of excel 2021, 365 and even previous versions.

[CODE=vba]
Sub copycolor_v3()
  Dim f As Range
 
  Set f = Range("Q2:Q14").Find(Range("T1").Value, , xlValues, xlWhole)
  If Not f Is Nothing Then
    Application.ScreenUpdating = False
    Range("startcell").Resize(1000, 5).Clear
    Sheets("hardcoded formatted data 13per.").Range(f.Offset(0, 1).Value).Copy Range("startcell")
    Range("T1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
  End If
End Sub

3. And finally the automatic version, (in the sheet event). The Take(Indirect...) formula is not necessary either, so it works for your Excel versions.
Only you changes the period in T1 and it automatically copies data and formats.

Private Sub Worksheet_Change(ByVal Target As Range)
 
  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) = "T1" Then
    If Target.Value = "" Then Exit Sub
     Dim f As Range
   
     Set f = Range("Q2:Q14").Find(Range("T1").Value, , xlValues, xlWhole)
     If Not f Is Nothing Then
       Application.ScreenUpdating = False
       Range("startcell").Resize(1000, 5).Clear
       Sheets("hardcoded formatted data 13per.").Range(f.Offset(0, 1).Value).Copy Range("startcell")
       Range("T1").Select
       Application.CutCopyMode = False
       Application.ScreenUpdating = True
     End If
  End If
End Sub

Note Sheet Event: Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

Note Sheet Name: In the macros set the sheet name "hardcoded formatted data 13per."

I return the file with all the macros:
File

----- --
I hope to hear from you soon.
Cordially
Dante Amor
----- --

 

[FrankLinssen]

Hi Dante,
Thanks for your efforts. This works
One final question: does something change to the first macro when I move the range Q1:R14 and cell T1 to another sheet (somewhere at the end of my file, which is much bigger than the example-file)?