Rename Sheet in Workbook Created based on unique Column data

Question

The code takes my current workbook's data, creates a new workbook for each unique item from Column AF, and pulls all row data for that unique value.

I also need to rename the new workbook sheet based on Column AG. I can rename the worksheet based on the unique value located in AF because I have this list stored as an Object variant but have been unable to rename the sheet correctly.

The rename was originally set to xNSht.Name = ky.

I tried:

xNSht.Name = xSht.Cells(i, xSName).Value

With the above I tried adding xSName to my dic Object and tried adding it to Dim I row as a Long

Dim xSName As Long 'This creates the new sheet with a value from column AG but it is not from the correct row that is being copied over (ky)

'OR tried to set it as its own line, which just errors out.
Dim i As Long, xCName As Long, xSName As Long

I also tried to set it to the new sheet's range of AG2 but that just errors and says AG2 is empty.
If I set it to the original worksheet (xSht) it uses the same AG2 value from the original sheet for every new sheet.

xNSht.Name = xNSht.Range("AG2").Value

How can I rename the new sheet based on the value in column AG being copied?

Full code

Sub Invoice_Split()
    Dim wbN As Workbook
    Dim xSht As Worksheet, xNSht As Worksheet
    Dim i As Long, xCName As Long
    Dim dic As Object, ky As Variant, lnk As Variant
    Dim xTitle As String

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
  
    Set xSht = ThisWorkbook.Sheets("Data")
    Set dic = CreateObject("Scripting.Dictionary")

    xCName = 32 'Change this number to the column number which you will create new sheets based on - currently set to AF

    xTitle = "A:AG"
  
  For i = 2 To xSht.Cells(Rows.Count, xCName).End(xlUp).Row
    If xSht.Cells(i, xCName).Value <> "" Then dic(xSht.Cells(i, xCName).Value) = xSht.Cells(i, "A").Value
  Next

    For Each ky In dic.keys
        ThisWorkbook.Sheets("CONTROL").Copy
        Set wbN = ActiveWorkbook
        xSht.Range(xTitle).AutoFilter xCName, ky
        Set xNSht = Worksheets.Add(, wbN.Sheets(wbN.Sheets.Count))
        xNSht.Name = xNSht.Range("AG2").Value
        ActiveWindow.DisplayGridlines = False
        xSht.AutoFilter.Range.EntireRow.Copy xNSht.Range("A1")
        xNSht.Columns.AutoFit
 
        'save workbook
        wbN.SaveAs ThisWorkbook.Path & "\" & ky
        wbN.Close False
    Next
  
    On Error Resume Next
    With ActiveWorkbook
        For Each lnk In .LinkSources(Type:=xlLinkTypeExcelLinks)
            .BreakLink Name:=lnk, Type:=xlLinkTypeExcelLinks
        Next
    End With
    On Error GoTo 0
    xSht.AutoFilterMode = False
  
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
End Sub

Why are you storing Column A as the dictionary value `dic(xSht.Cells(i, xCName).Value) = xSht.Cells(i, "A").Value`. If you used the column AG value then the save name becomes `dict(ky)` rather that `ky`. — CDP1802, Dec 04 '21 at 17:49
Good point - I originally had my data in column A but never changed this when I adjusted the order. Thanks for pointing that out! — Blackmagic42, Dec 04 '21 at 18:09

pgSystemTester · Accepted Answer · 2021-12-04T18:04:04.043

I think you need to change the order you're setting the name. When you set it, you haven't put the values in. Try changing these three lines to be as follows:

Old

xNSht.Name = xNSht.Range("AG2").Value
ActiveWindow.DisplayGridlines = False
xSht.AutoFilter.Range.EntireRow.Copy xNSht.Range("A1")

New

xSht.AutoFilter.Range.EntireRow.Copy xNSht.Range("A1")
xNSht.Name = xNSht.Range("AG2").Value
ActiveWindow.DisplayGridlines = False

if that doesn't work, try using the stop vba debugging tool and check your various variables (or better yet use the debugging tool with immediate window)

Example...

Debug.Print xNSht.Range("AG2").Value
Stop
xNSht.Name = xNSht.Range("AG2").Value
'did this work?

Debug.Print ky
xNsht.Name = ky
Stop
'did this work?

Debug.Print dic(ky)
xNSht.Name = dic(ky)
'did this work?
Stop
'etc...

Rename Sheet in Workbook Created based on unique Column data

1 Answers1

Linked