VBA Creating New WB based on unique Column data - Need to Rename Sheet in New WB-CodePudding

The code I'm using takes my current workbooks data and creates a new workbook for each unique item from a certain column (Column AF) and pulls all row data for that unique value. What I also need it to do is rename the new workbooks sheet based on a different column (Column AG) but have been unable to get it to work properly. I can have it rename the worksheet based on the unique value located in AF because I have this list stored as a Object variant but have been unable to figure out how to rename the sheet correctly.

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

I've tried the following:

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 it's 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 sheets range of AG2 but that just errors and says AG2 is empty. If I set it to the original worksheet (xSht) it uses same AG2 value from original sheet for every new sheet, which is incorrect.

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

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

FULL CODE BELOW

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

CodePudding user response：

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...