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

CodePudding user response：

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 following table lists the values that can be passed in the Type argument 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