VBA to insert Range

[JFuller]

I've been looking all over and trying to adapt codes and I'm striking out on this.

On my worksheet, I want to insert a named range above an active cell. So I have lots of named ranges, and when I select a cell, I want to be able to run a macro that inserts a named range above. it could be one line, it could be 20 lines. I've recorded macros where I manually copy the range, then go to the active cell and insert the copied cells above, moving the existing rows down, but I cant figure out how to adapt this to the activecell property (If that's even what I should be doing).

Here's a recorded macro where I copy a range, than insert it and move the selection down. But I want this to be done with a macro.

Sub Macro3()
'
' Macro3 Macro
'

'
Sheets("OPTIONS").Select
Application.Goto Reference:="INTERNAL_BELOWHOOPS"
Application.CutCopyMode = False
Selection.Copy
Sheets("MAIN").Select
Rows("201:201").Select
Selection.Insert Shift:=xlDown


End Sub

It could be one macro per named range, but what would be really nice is if there was a drop down with all of the available named ranges as well that popped up when the macro ran. Otherwise I would have to make a separate macro for each range which would be fine too

Thank you!

 

[Max1616]

I have a named range "Test1" where this is working as you described:

Sub InsertRange()

Dim ws As Worksheet

Set ws = Sheets("OPTIONS")

ws.Range("Test1").Copy 'Edit your named range here (i.e. replace "Test1")
ActiveCell.Insert Shift:=xlDown
Application.CutCopyMode = False

End Sub

Hopefully this helps!

 

[JFuller]

Fantastic! That is working great. Could you adapt this code to paste across several tabs?

Right now I'm highlighting a cell in row B and the macro is inserting that range starting in B and shifting everything down which is exactly what I want. Now I just want it to mimic this process across quite a number of tabs. You could call them Sheet1, Sheet2, Sheet 3 for simplicity.

Thank you!!

 

[JFuller]

actually I think I got it by adding a Call

Sub b_InsertRangeSAM()

Dim ws As Worksheet

Set ws = Sheets("INTERNAL")

ws.Range("INTERNAL_LENGTH_ITEM_2").Copy 'Edit your named range here (i.e. replace "Test1")
Call M_Highlight_All_Options
ActiveCell.Insert Shift:=xlDown
Application.CutCopyMode = False

End Sub

 

[John_w]

It could be one macro per named range, but what would be really nice is if there was a drop down with all of the available named ranges as well that popped up when the macro ran. Otherwise I would have to make a separate macro for each range which would be fine too

See how well this macro, Copy_and_Insert_Named_Range, works for you. When you run it, it creates a drop down (forms combo box) named "NamedRanges" in A1:C1 of the active sheet with all the named ranges listed and sets the same macro as the drop down's OnAction routine. Now if you select a named range from the drop down it will insert the values of that range at the active cell. If necessary, run the Delete_Dropdown_NamedRanges macro to delete the drop down.

Public Sub Copy_and_Insert_Named_Range()

    Dim AppCaller As String
    Dim cb As DropDown
    Dim cbValue As String
    Dim namedRange As Name
    
    On Error Resume Next
    AppCaller = Application.Caller
    Set cb = ActiveSheet.DropDowns("NamedRanges")
    On Error GoTo 0
    
    If cb Is Nothing Then
    
        'The "NamedRanges" dropdown doesn't exist so create it, with this procedure as its OnAction routine
    
        With ActiveSheet.Range("A1:C1")
            Set cb = .Worksheet.DropDowns.Add(.Left, .Top, .Width, .Height)
        End With
    
        With cb
            .Name = "NamedRanges"
            .OnAction = "Copy_and_Insert_Named_Range"
            .AddItem "Select named range"
            For Each namedRange In ActiveWorkbook.Names
                .AddItem namedRange.Name & " " & namedRange.RefersTo
            Next
        End With
    
    ElseIf AppCaller = "NamedRanges" Then
           
        'This procedure has been called by the "NamedRanges" dropdown OnAction
        
        cbValue = cb.List(cb.Value)
        
        If cbValue <> "Select named range" Then
        
            Set namedRange = ActiveWorkbook.Names(Split(cbValue, " ")(0))
            
            With ActiveCell
                .EntireRow.Insert Shift:=xlDown
                namedRange.RefersToRange.Copy
                .Offset(-1).PasteSpecial xlPasteValues
            End With
            Application.CutCopyMode = False
        
        End If
        
    Else
    
        MsgBox "Select a named range from the 'NamedRanges' drop down", vbExclamation
        
    End If
        
End Sub


Public Sub Delete_Dropdown_NamedRanges()

    On Error Resume Next
    ActiveSheet.DropDowns("NamedRanges").Delete
    On Error GoTo 0

End Sub

 

[JFuller]

You blew my mind there. That's really awesome, thank you! Is there a way to narrow down the named ranges in the drop down? Say, if they started with a particular word?

Ex: only show named ranges that start "INTERNAL."

Also the drop down shows the actual cell range, IE A1:D55, could that be shortened?

Thanks!

 

[John_w]

Both changes implemented:

Public Sub Copy_and_Insert_Named_Range()

    Dim AppCaller As String
    Dim cb As DropDown
    Dim cbValue As String
    Dim namedRange As Name
    
    On Error Resume Next
    AppCaller = Application.Caller
    Set cb = ActiveSheet.DropDowns("NamedRanges")
    On Error GoTo 0
    
    If cb Is Nothing Then
    
        'The "NamedRanges" dropdown doesn't exist so create it, with this procedure as its OnAction routine
    
        With ActiveSheet.Range("A1:C1")
            Set cb = .Worksheet.DropDowns.Add(.Left, .Top, .Width, .Height)
        End With
    
        With cb
            .Name = "NamedRanges"
            .OnAction = "Copy_and_Insert_Named_Range"
            .AddItem "Select named range"
            For Each namedRange In ActiveWorkbook.Names
                If InStr(1, namedRange.Name, "INTERNAL", vbTextCompare) = 1 Then .AddItem namedRange.Name
            Next
        End With
    
    ElseIf AppCaller = "NamedRanges" Then
           
        'This procedure has been called by the "NamedRanges" dropdown OnAction
        
        cbValue = cb.List(cb.Value)
        
        If cbValue <> "Select named range" Then
        
            Set namedRange = ActiveWorkbook.Names(cbValue)
            
            With ActiveCell
                .EntireRow.Insert Shift:=xlDown
                namedRange.RefersToRange.Copy
                .Offset(-1).PasteSpecial xlPasteValues
            End With
            Application.CutCopyMode = False
        
        End If
        
    Else
    
        MsgBox "Select a named range from the 'NamedRanges' drop down", vbExclamation
        
    End If
        
End Sub

 

[JFuller]

Could you show me how to wrap this code so that my user can only run the code if their active sell is in column B? I know its something like this:

If ActiveCell.Column = 2 Then
    'Copy code goes here
Else
    MsgBox "Message"
End If

 

[John_w]

Could you show me how to wrap this code so that my user can only run the code if their active sell is in column B?

        If cbValue <> "Select named range" Then
                    
            Set namedRange = ActiveWorkbook.Names(cbValue)

            With ActiveCell
                If .Column = 2 Then
                    .EntireRow.Insert Shift:=xlDown
                    namedRange.RefersToRange.Copy
                    .Offset(-1).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                Else
                    MsgBox "The active cell must be in column B", vbExclamation
                End If
            End With
        
        End If

 

[JFuller]

Thank you!