CodesiriuS
New Member
- Joined
- Dec 18, 2016
- Messages
- 27
I have the code that the user can pulls up the C: directory, select the file and once selected the file path appears in a text box. The issue is I'm having a hard time getting the code to format the file that is selected in the texbox rather than the active worksheet. Would you happen to know if this is a simple fix like maybe instead of activeworksheet its selectedworksheet... Any help or even book references would be great I don't mind researching I'm just kind of at a dead-end at the moment
Private Sub CommandButton1_Click()
Dim SelectedFile As String
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select required files"
.AllowMultiSelect = False
.InitialFileName = "Computer:"
.Filters.Clear
.Filters.Add "Excel Documents", "*.Xlsx", 1
.Filters.Add "Excel Documents", "*.Xls", 1
If .Show Then
SelectedFile = .SelectedItems(1)
Me.TextBox1 = SelectedFile
Else
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
End With
End Sub
Private Sub CommandButton2_Click()
Application.Run "Cleanup"
End Sub
--------------------------------------------------
Cleanup(module1)
Sub Cleanup()
Dim ws1 As Worksheet, ws2 As Worksheet
'setup
Application.ScreenUpdating = False
Set ws1 = ActiveSheet
'delete existing
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("NEW").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'add new
Worksheets.Add.Name = "FDM FORMATTED"
Set ws2 = Worksheets("FDM FORMATTED")
'copy data from 1 to 2
ws1.UsedRange.Copy
ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'delete rows with col A blank
On Error Resume Next
ws2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'delete rows with col C blank
On Error Resume Next
ws2.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'delete rows with col D text
On Error Resume Next
ws2.Columns(4).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
On Error GoTo 0
'delete rows with col F numbers
On Error Resume Next
ws2.Columns(6).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
On Error GoTo 0
'cleanup
Application.ScreenUpdating = True
ws2.Select
ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub
Private Sub CommandButton1_Click()
Dim SelectedFile As String
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select required files"
.AllowMultiSelect = False
.InitialFileName = "Computer:"
.Filters.Clear
.Filters.Add "Excel Documents", "*.Xlsx", 1
.Filters.Add "Excel Documents", "*.Xls", 1
If .Show Then
SelectedFile = .SelectedItems(1)
Me.TextBox1 = SelectedFile
Else
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
End With
End Sub
Private Sub CommandButton2_Click()
Application.Run "Cleanup"
End Sub
--------------------------------------------------
Cleanup(module1)
Sub Cleanup()
Dim ws1 As Worksheet, ws2 As Worksheet
'setup
Application.ScreenUpdating = False
Set ws1 = ActiveSheet
'delete existing
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("NEW").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'add new
Worksheets.Add.Name = "FDM FORMATTED"
Set ws2 = Worksheets("FDM FORMATTED")
'copy data from 1 to 2
ws1.UsedRange.Copy
ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'delete rows with col A blank
On Error Resume Next
ws2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'delete rows with col C blank
On Error Resume Next
ws2.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'delete rows with col D text
On Error Resume Next
ws2.Columns(4).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
On Error GoTo 0
'delete rows with col F numbers
On Error Resume Next
ws2.Columns(6).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
On Error GoTo 0
'cleanup
Application.ScreenUpdating = True
ws2.Select
ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub
Last edited: