asked on

Named range not carried over

I had this question after viewing Tab names are off by one.

One of the named ranges carries over, but one of them doesn't. I would like to expand the code to ensure that whatever the named ranges were to begin with, remain after the script has run.

Assistance with the code below is greatly appreciated.

Sub Separate_by_Filename_Column_Into_Separate_Workbooks()

'This routine will separate the active sheet into separate workbook files
'based on the filename given in the filename column.
'If this workbook contains a sheet (tab) named "Validate" with named ranges for validation,
'and with validation columns in the original sheet, it should keep the named ranges,
'and the validation columns, as well as the name of the originating sheet.


Dim aFiles As Variant

strDirectory = GetFolder(ActiveWorkbook.path)
If strDirectory = "" Then Exit Sub
Set origSh = ActiveSheet
Set rngFound = Nothing
On Error Resume Next
Set rngFound = Range("1:1").Find("Filename")
On Error GoTo 0
If Not rngFound Is Nothing Then
    strCol = Split(rngFound.Address, "$")(1)
    Set myRange = Range(Range(strCol & "2"), Range(strCol & Rows.Count).End(xlUp))
    ActiveWorkbook.Sheets.Add
    myRange.Copy ActiveSheet.Range("A1")
    Application.DisplayAlerts = False
    Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
    aFiles = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    For Each C In aFiles
        origSh.Copy
        Set newWbk = ActiveWorkbook
        Set newSh = newWbk.ActiveSheet
        Set myNewRange = Range(Range(strCol & "1"), Range(strCol & Rows.Count).End(xlUp))
        myNewRange.AutoFilter Field:=rngFound.Column, Criteria1:="<>" & C, VisibleDropDown:=True
        Set origRng = Nothing
        On Error Resume Next
        Set origRng = newSh.Range(Range(strCol & "2"), Range(strCol & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow
        On Error GoTo 0
        If Not origRng Is Nothing Then
            ActiveSheet.ShowAllData
            For Each ar In origRng.Areas
                ar.Delete
            Next
        End If
        origSh.Parent.Sheets("Validate").Copy after:=newSh
        newWbk.Sheets("Validate").Visible = xlSheetHidden
        newSh.Activate
        newSh.Name = Left(C, 31)
        newSh.Range("A2").Activate
        newWbk.SaveAs strDirectory & "\" & C
        newWbk.Close False
    Next
End If
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Open in new window

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Ted Penner

ASKER

The named range entitled Plan from the validate tab is not copied where the named range entitled FollowUp is copied.

It is further puzzling that the cell contents of the named range entitled Plan cannot be changed even from within that tab, but the ones in the named range FollowUp can be.

SOLUTION

AndyAinscow

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Ted Penner

ASKER

I suppose that makes sense. What do you think Rg? How can we implement that?

AndyAinscow

>>How can we implement that?
If you are referring to my suggestion then the code snippet I posted will copy a worksheet from one workbook into another. (It is implemented).

Ted Penner

ASKER

I meant incorporate that into the code we already have in the above post.

AndyAinscow

Without looking at it you would probably have to delete most of it.
Before one starts just perform a quick test and see if the copy does result in what you want. (I don't see why it should not do). You need to have both the source and target workbooks open in excel, creat a macro, paste the above code into it, change the sheet and workbooknames in code to match your real situation.

Ted Penner

ASKER

I had selected 'custom' in data validation in the first named range and 'any value' in the second.

It turns out that you can protect the redefining of the range itself to some degree so that it is not obvious how to change those values.

Still testing but I think when you do that, it causes the issue we are experiencing. More to come.

Ted Penner

ASKER

Thanks for the assistance. I think we got it.

The problem was that I had set custom and it wouldn't let me copy the named ranges.

Ted Penner

ASKER

Followup posted here >> https://www.experts-exchange.com/questions/28940852/Process-filename-extension.html

Thank you again sir.