CodesiriuS
12-20-2016, 08:03 PM
Hello I'm just looking for a code to shut down my user form and give the user and option to save -
I have a one button command button that 1. calls up a directory 2. Allows the user to Selects the file 3. then opens the selected file
The issue - I can't save the selected workbook until the form closes and that's where I get stuck this is what I have so far - Any help would be great
Private Sub CommandButton1_Click()
Dim wbOpen As Workbook
Dim SelectedFile As String
ChDir "C:" ' change this to open the dialog in a specific directory if required
SelectedFile = Application.GetOpenFilename("Excel Workbooks (*.xls*),*.xls*", , "Please select workbook to format")
If SelectedFile <> "False" Then
Set wbOpen = Workbooks.Open(SelectedFile)
Cleanup wbOpen
End If
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub
---------------------------------------
Option Explicit
Sub Cleanup(wb As Workbook)
Dim ws1 As Worksheet, ws2 As Worksheet
'setup
Application.ScreenUpdating = False
With wb
Set ws1 = .ActiveSheet
On Error Resume Next
'delete existing
Application.DisplayAlerts = False
.Worksheets("NEW").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'add new
Set ws2 = Worksheets.Add
ws2.Name = "FDM FORMATTED"
End With
'copy data from 1 to 2 this alll will be used to explain the other differences
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.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub
I have a one button command button that 1. calls up a directory 2. Allows the user to Selects the file 3. then opens the selected file
The issue - I can't save the selected workbook until the form closes and that's where I get stuck this is what I have so far - Any help would be great
Private Sub CommandButton1_Click()
Dim wbOpen As Workbook
Dim SelectedFile As String
ChDir "C:" ' change this to open the dialog in a specific directory if required
SelectedFile = Application.GetOpenFilename("Excel Workbooks (*.xls*),*.xls*", , "Please select workbook to format")
If SelectedFile <> "False" Then
Set wbOpen = Workbooks.Open(SelectedFile)
Cleanup wbOpen
End If
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub
---------------------------------------
Option Explicit
Sub Cleanup(wb As Workbook)
Dim ws1 As Worksheet, ws2 As Worksheet
'setup
Application.ScreenUpdating = False
With wb
Set ws1 = .ActiveSheet
On Error Resume Next
'delete existing
Application.DisplayAlerts = False
.Worksheets("NEW").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'add new
Set ws2 = Worksheets.Add
ws2.Name = "FDM FORMATTED"
End With
'copy data from 1 to 2 this alll will be used to explain the other differences
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.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub