VBA to copy a template from one sheet to another based on dropdown

[altizerc2196]

Hello! New to VBA and I've looked through every post I can find that would fit my use with no success.. I am trying to copy a schedule "template" from one sheet to another based on if a data validation dropdown matches the value in row 1 of the second sheet.

Dropdown is in Sheet "Add A Project" Cell B3 (Cells B3:D3 are merged if that matters). Validation options are currently "Sell Sheet", "Website", "Media Execution", and "Media Reporting". Validations are pulled from Sheet "Schedule Templates" Range A:AA

"Add A Project" Sheet:

Ideally, if I selected "Sell Sheet" from the data validation dropdown, it would search Sheet "Schedule Templates" Range A:AA for "Sell Sheet", Copy the schedule template from below "Sell Sheet" (In this case, Schedule Templates!A2:A16) and paste back into "Add A Project" starting at B8. If I selected "Website" It would do the same thing, but resulting in copying Schedule Templates!B2:B24 to Add A Project!B8.

"Schedule Templates" Sheet:

Desired Outcome:

I am unable to use formulas like xlookup or vlookup in column B because it interferes with other macros I have in the workbook.

I'm at the end of my wits, so many thanks in advance and please let me know if there's any other info I can provide.

 

[John_w]

Try this code in the "Add A Project" sheet module:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim templateCol As Variant
   
    If Target.Address = "$B$3" Then
        Range("B8", Cells(Rows.Count, "B").End(xlUp)).ClearContents
        With Evaluate(Target.Validation.Formula1).Worksheet
            templateCol = Application.Match(Target.Value, .Rows(1), 0)
            If Not IsError(templateCol) Then
                .Range(.Cells(2, templateCol), .Cells(.Rows.Count, templateCol).End(xlUp)).Copy Range("B8")
            End If
        End With
    End If
    
End Sub

 

[altizerc2196]

Try this code in the "Add A Project" sheet module:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim templateCol As Variant
  
    If Target.Address = "$B$3" Then
        Range("B8", Cells(Rows.Count, "B").End(xlUp)).ClearContents
        With Evaluate(Target.Validation.Formula1).Worksheet
            templateCol = Application.Match(Target.Value, .Rows(1), 0)
            If Not IsError(templateCol) Then
                .Range(.Cells(2, templateCol), .Cells(.Rows.Count, templateCol).End(xlUp)).Copy Range("B8")
            End If
        End With
    End If
   
End Sub

Hmmm, I tried this one and it doesn't seem like it's working. At least it's not triggering when I change cell B3 to any of the validation options

 

[John_w]

Your screenshot shows you've added the code to a standard module. It must go in the sheet module instead, as that can capture worksheet events. Right-click the "Add A Project" sheet tab and click View Code and paste the code into the sheet module.

 

[altizerc2196]

Your screenshot shows you've added the code to a standard module. It must go in the sheet module instead, as that can capture worksheet events. Right-click the "Add A Project" sheet tab and click View Code and paste the code into the sheet module.

Didn't realize there was a difference, so many thanks for the heads up there - likely why a lot of other posts I tried weren't working.

I posted the same code in the Add A Project worksheet VBA - selecting a validation option in B3 still isn't causing anything to happen. Let me know if there's other things I'm missing:

Many thanks for working with me on this

 

[John_w]

It looks like the code is in the correct place now. Add this line after the Dim line to show whether the Worksheet_Change handler is being called:

    MsgBox Target.Address

It shows the address of the changed cell(s).

 

[altizerc2196]

Added it in, doesn't seem to have changed anything

 

[John_w]

Worksheet_Change should be called if you change any cell on the "Add A Project", if it's in that sheet's module.. The fact that it isn't suggests events have been disabled, therefore run this macro to enable them:

Public Sub Enable_Events()
    Application.EnableEvents = True
End Sub

 

[altizerc2196]

Hi there! This started working suddenly, I believe after achieving a similar result to what you posted by ctrl+g > "Application.EnableEvents" > enter. Thank you so much for your help thus far!

I'd like to develop this a bit further by also copying and pasting a duration of the tasks in Add A Project!C7:C100:

I thought it would be best to insert a row next to each respective template of the Schedule Templates Sheet:

But merging "Sell Sheet" across A1:B1 adds an unwanted space in the data validation of Add A Project!B7:

All ears if you have a suggestion on how to set this up and update the VBA to get the desired outcome:

I've changed the workbook a bit, so VBA has been updated to:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim templateCol As Variant

    If Target.Address = "$B$3" Then
    Range("B7:B100").Value = ""
        With Evaluate(Target.Validation.Formula1).Worksheet
            templateCol = Application.Match(Target.Value, .Rows(1), 0)
            If Not IsError(templateCol) Then
                .Range(.Cells(2, templateCol), .Cells(.Rows.Count, templateCol).End(xlUp)).Copy Range("B7")
            End If
        End With
    End If
    
End Sub

Thanks so much

 

[John_w]

I thought it would be best to insert a row next to each respective template of the Schedule Templates Sheet:

Ok, but I think you mean a column.

But merging "Sell Sheet" across A1:B1 adds an unwanted space in the data validation of Add A Project!B7:

Don't merge. For the Data Validation source, instead of:

Validations are pulled from Sheet "Schedule Templates" Range A:AA

put the dropdown values in a range of cells in a single column, e.g. "Schedule Templates" J2:J5 and use that as the source.

The Worksheet_Change code to copy the 2 columns to B7:C<last row> is then:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim templateCol As Variant

    If Target.Address = "$B$3" Then
        Range("B7", Cells(Rows.Count, "C").End(xlUp)).ClearContents
        With Evaluate(Target.Validation.Formula1).Worksheet
            templateCol = Application.Match(Target.Value, .Rows(1), 0)
            If Not IsError(templateCol) Then
                .Range(.Cells(2, templateCol), .Cells(.Rows.Count, templateCol + 1).End(xlUp)).Copy Range("B7")
            End If
        End With
    End If
    
End Sub