Excel VBA let user to input new sheet name - excel

Question

I have code to list all files in chosen folder. Now it creates new sheet with name "Files". How to modify this code to let user input folder name every time he clicks the button? So basically scenario would look like this:
Click button
Choose folder to List files from
Type new Worksheet name where files will be listed
Code processed
Click button
Choose folder to List files from
Type new Worksheet name where files will be listed
Code processed
Same actions till the end of the world
I have tried this one but probably have mistakes inputting to my code:
Dim NewName As String
NewName = InputBox("What Do you Want to Name the Sheet1 ?")
Sheets("Sheet1").Name = NewName
I have tried to modify this with:
Sheets.Add.Name = NewName
Sheets(NewName).[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
My code for listing files and full path to each file:
Sub ListAllFilesInAllFolders()
Dim MyPath As String, MyFolderName As String, MyFileName As String
Dim i As Integer, F As Boolean
Dim objShell As Object, objFolder As Object, AllFolders As Object, AllFiles As Object
Dim MySheet As Worksheet
On Error Resume Next
'************************
'Select folder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "", 0, 0)
If Not objFolder Is Nothing Then
'MyPath =
MyPath = objFolder.self.Path & "\"
Else
Exit Sub
End If
Set objFolder = Nothing
Set objShell = Nothing
'************************
'List all folders
Set AllFolders = CreateObject("Scripting.Dictionary")
Set AllFiles = CreateObject("Scripting.Dictionary")
AllFolders.Add (MyPath), ""
i = 0
Do While i < AllFolders.Count
Key = AllFolders.keys
MyFolderName = Dir(Key(i), vbDirectory)
Do While MyFolderName <> ""
If MyFolderName <> "." And MyFolderName <> ".." Then
If (GetAttr(Key(i) & MyFolderName) And vbDirectory) = vbDirectory Then
AllFolders.Add (Key(i) & MyFolderName & "\"), ""
End If
End If
MyFolderName = Dir
Loop
i = i + 1
Loop
'List all files
For Each Key In AllFolders.keys
MyFileName = Dir(Key & "*.*")
'MyFileName = Dir(Key & "*.PDF") 'only PDF files
Do While MyFileName <> ""
AllFiles.Add (Key & MyFileName), ""
MyFileName = Dir
Loop
Next
'************************
'List all files in Files sheet
For Each MySheet In ThisWorkbook.Worksheets
If MySheet.Name = "Files" Then
Sheets("Files").Cells.Delete
F = True
Exit For
Else
F = False
End If
Next
If Not F Then Sheets.Add.Name = "Files"
'Sheets("Files").[A1].Resize(AllFolders.Count, 1) = WorksheetFunction.Transpose(AllFolders.keys)
Sheets("Files").[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
Set AllFolders = Nothing
Set AllFiles = Nothing
End Sub

Answer 1

Try using
With Sheets.Add
.Name = NewName
.Range("A1").Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
End With
Also, no need to to loop to test if the sheet exists. Use Error Handling instead
Dim FilesSheet as Worksheet
On Error Resume Next
Set FilesSheet = Thisworkbook.Sheets("Files")
On Error GoTo 0
If Not FilesSheet is Nothing then
F = True
Set FilesSheet = ThisWorkbook.Sheets.Add
FilesSheet.Name = NewName
Else
F = False
FilesSheet.Cells.Delete
End If
FilesSheet.Range("A1").Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
If you are creating this for End Users you may also want to build in functionality to check that the NewName they enter isn't too long (>31 Characters) for an Excel Sheet Name and doesn't contain any illegal characters (\ / * [ ] : ?)