Follow up to splitting a sheet into multiple workbooks - excel

Question

I am trying to modify this code found here.
The code works great, but want to know how to enter column letter instead of number.
I believe it has something to do with this line
sCol = Application.InputBox(aibPrompt, aibtitle, aibDefault, , , , , 1)
but not able to get it to work.
Here is the code as found on the other page.
Option Explicit
Sub ExportToWorkbooks()
Const aibPrompt As String = "Which column would you like to filter by?"
Const aibtitle As String = "Filter Column"
Const aibDefault As Long = 3
Dim dFileExtension As String: dFileExtension = ".xlsx"
Dim dFileFormat As XlFileFormat: dFileFormat = xlOpenXMLWorkbook
Dim dFolderPath As String: dFolderPath = "C:\Users\WalteR01\Desktop\VPN Revalidations\Split by Manager\"
If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
If Len(Dir(dFolderPath, vbDirectory)) = 0 Then Exit Sub ' folder not found
If Left(dFileExtension, 1) <> "." Then dFileExtension = "." & dFileExtension
Application.ScreenUpdating = False
Dim sCol As Variant
sCol = Application.InputBox(aibPrompt, aibtitle, aibDefault, , , , , 1)
If Len(CStr(sCol)) = 0 Then Exit Sub ' no entry
If sCol = False Then Exit Sub ' canceled
Dim sws As Worksheet: Set sws = ActiveSheet
If sws.FilterMode Then sws.ShowAllData
Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
Dim srCount As Long: srCount = srg.Rows.Count
If srCount < 3 Then Exit Sub ' not enough rows
Dim srrg As Range: Set srrg = srg.Rows(1) ' to copy column widths
Dim scrg As Range: Set scrg = srg.Columns(sCol)
Dim scData As Variant: scData = scrg.Value
' Write the unique values from the 1st column to a dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare ' case insensitive
Dim Key As Variant
Dim r As Long
For r = 2 To srCount
Key = scData(r, 1)
If Not IsError(Key) Then ' exclude error values
If Len(Key) > 0 Then ' exclude blanks
dict(Key) = Empty
End If
End If
Next r
If dict.Count = 0 Then Exit Sub ' only error values and blanks
Erase scData
Dim dwb As Workbook
Dim dws As Worksheet
Dim dfcell As Range
Dim dFilePath As String
Dim DateText As String: DateText = Format(Date, "_mm_yyyy")
For Each Key In dict.Keys
' Add a new (destination) workbook and reference the first cell.
Set dwb = Workbooks.Add(xlWBATWorksheet) ' one worksheet
Set dws = dwb.Worksheets(1)
Set dfcell = dws.Range("A1")
' Copy/Paste
srrg.Copy
dfcell.PasteSpecial xlPasteColumnWidths
srg.AutoFilter sCol, Key
srg.SpecialCells(xlCellTypeVisible).Copy dfcell
sws.ShowAllData
dfcell.Select
' Save/Close
dFilePath = dFolderPath & Key & DateText & dFileExtension ' build the file path
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs dFilePath, xlOpenXMLWorkbook
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
Next Key
sws.AutoFilterMode = False
Application.ScreenUpdating = True
MsgBox "Data exported.", vbInformation
End Sub
I have tried to change the line as stated but no luck. The application inbox is what I need to update but not sure how. This is the page I have been using https://learn.microsoft.com/en-us/office/vba/api/excel.application.inputbox

Answer 1

Dim sCol As Variant
sCol = Application.InputBox(aibPrompt, aibtitle, aibDefault, , , , , 1)
As documented here: https://learn.microsoft.com/en-us/office/vba/api/excel.application.inputbox#:~:text=The%20following%20table%20lists%20the%20values%20that%20can%20be%20passed%20in%20the%20Type%20argument
The last argument controls what type of value(s) can be accepted by the InputBox: 1 = Numeric so you need to swap that out for 2 (Text)
sCol = Application.InputBox(aibPrompt, aibtitle, aibDefault, , , , , 2)
OK now I read down... When you call srg.AutoFilter sCol, Key the first argument to AutoFilter should be the column number in the range to be filtered to which the filter should be applied.
Note if your table doesn't start in ColA there needs to be some adjustment, but if it does you could use Cells(1, sCol).Column to convert your column letter, so try:
srg.AutoFilter sws.Cells(1, sCol).Column, Key