I am using Excel 2016
Previous question / thread is here
I have two worksheets "Data_Import" and "Pack".
Existing code imports folder names starting in the first blank cell of Column A.Then for every row that has new data it sets the row height to 18 and Column A to autofit,
This works perfectly.
I also need to clear all data in Column A of "Data_Import" and to start at Cell A1 and set the row heights to 18 and Column A to autofit.
Also do the same for worksheet "Pack" and for every row that has new data it sets the row height to 18 and Column A to autofit.
I am unable to get the "Pack" sheet for every row that has new data it sets the row height to 18 and Column A to autofit to work, the macro sets ALL rows to row height to 18 and it does not set AutoFit.
I would be grateful for any suggestions, many thanks.
Existing code from my other question
Sub GetFolderNames()
Dim Answer As VbMsgBoxResult
Dim xRow As Long
Dim vSF As Object
Dim xDirect$
Dim InitialFoldr$
Dim ws As Worksheet: Set ws = Sheets("Data_Import")
Answer = MsgBox("Are you sure you want to run the macro - Import Folder Names", vbYesNo, "Run Import Folder Names Macro")
If Answer = vbYes Then
Application.ScreenUpdating = False
xRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
InitialFoldr$ = "F:\" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
End If
End With
If xDirect$ <> "" Then
With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
For Each vSF In .subfolders
ws.Cells(xRow, 1) = Mid(vSF, InStrRev(vSF, "\") + 1)
xRow = xRow + 1
Next vSF
End With
ws.Columns("A:A").AutoFit
End If
End If
End Sub
This is how I have tried to modify it so far
Sub ClearAllGetNewFolderNames()
Dim xRow&, vSF
Dim xDirect$, InitialFoldr$
Dim Answer As VbMsgBoxResult
Dim x As Integer
Dim y As Integer
Dim myRow As Integer
Answer = MsgBox("Are You Sure You Want To Clear All Existing " & vbNewLine & "Data Records Before Importing New Data", vbYesNo, "Import Data")
InitialFoldr$ = "F:\" '<<< Startup folder to begin searching from
If Answer = vbYes Then
Sheets("Data_Import").Select
Columns("A:A").Select
Selection.ClearContents
Range("A1").Select
Rows.RowHeight = 10
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
End If
End With
If xDirect$ <> "" Then
With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
For Each vSF In .subfolders
ActiveCell.Offset(xRow) = Mid(vSF, InStrRev(vSF, "\") + 1)
xRow = xRow + 1
Next vSF
End With
End If
For x = 1 To ActiveSheet.UsedRange.Rows.Count
ActiveSheet.UsedRange.Rows.RowHeight = 18
Columns("A").EntireColumn.AutoFit
Next x
Sheets("Pack").Select
For x = 1 To ActiveSheet.UsedRange.Rows.Count
ActiveSheet.UsedRange.Rows.RowHeight = 18
Columns("A:H").EntireColumn.AutoFit
Next x
End Sub
Best Answer
Try this:
I am going to edit your question to be a little more concise.
Hope this helps. Justin