PDA

View Full Version : VBA Command button



CodesiriuS
12-21-2016, 01:33 AM
Hello I feel like I have been a pest to this forum since I joined and I apologize for that but I have been working on this userform that I want to make into an exe. utility of sorts - Thank you for any and all that have helped me thus far but I'm just missing one more piece of this puzzle and I'm hoping somebody could help see me through. :banghead::banghead:

I have a user form that has 2 buttons and a text box - the 1st command button opens up a the local directory to allow the user to pick a file and once a file is selected the textbox is populated with the file path - so that part works so far

issue # 1
when the selected file is opened I am unable to save or even exit out because the form is still open on the other workbook- what I was hoping to do is maybe have the user select the file but not open it so that they are still on the form and then the can press the 2nd command button which will call my formatting macro "Cleanup"

issue # 2
my command button is getting stuck because its telling me my text box is empty - and that the problem I don't know how to call my macro and direct it to the file path in my textbox





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)
Me.TextBox1 = SelectedFile
End If
End Sub

Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook
Set wThis = ThisWorkbook
Set wThat = Workbooks(TextBox1.Value)
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Call Cleanup(ws)
Next
Application.ScreenUpdating = True
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
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

Bob Phillips
12-21-2016, 02:51 AM
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

Me.TextBox1 = SelectedFile
End If
End Sub

Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook

Set wThis = ThisWorkbook
Set wThat = Workbooks(TextBox1.Value)

Application.ScreenUpdating = False

Set wbOpen = Workbooks.Open(Me.TextBox1.Text)

For Each ws In wbOpen.Worksheets

Call Cleanup(ws)
Next

Application.ScreenUpdating = True
End Sub

CodesiriuS
12-21-2016, 09:25 AM
Hi XLD -

the code is getting hung up "out of range error" here:


Set wThat = Workbooks(TextBox1.Value)

SamT
12-21-2016, 10:46 AM
SelectedFile = Application.GetOpenFilename("Excel Workbooks (*.xls*),*.xls*", , "Please select workbook to format")
'
'
'
Me.TextBox1 = SelectedFile
'
'
'
'Add this line:
MsgBox TextBox1.Value
'Before this line
Set wThat = Workbooks(TextBox1.Value)

CodesiriuS
12-21-2016, 11:31 AM
Hey Sam - I still get an error

CodesiriuS
12-21-2016, 11:43 AM
it seems to be a range issue

SamT
12-21-2016, 01:13 PM
What is the output of the MsgBox say?

CodesiriuS
12-21-2016, 02:06 PM
Run time error 9 Subscript out of Range - on this line
Set wThat = Workbooks(TextBox1.Value)


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)
Me.TextBox1 = SelectedFile
End If
End Sub


Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook
Set wThis = ThisWorkbook
MsgBox TextBox1.Value
Set wThat = Workbooks(TextBox1.Value)
Application.ScreenUpdating = False
Set wbOpen = Workbooks.Open(Me.TextBox1.Text)
For Each ws In wbOpen.Worksheets
Call Cleanup(ws)
Next
Application.ScreenUpdating = True
End Sub

SamT
12-21-2016, 06:28 PM
What does the output of the MsgBox say?

CodesiriuS
12-21-2016, 07:43 PM
the output is the file path of the file selected: "C:\Users\wilsoel\Desktop\Sample 1.xls"

Aussiebear
12-22-2016, 02:11 AM
the output is the file path of the file selected: "C:\Users\wilsoel\Desktop\Sample 1.xls"

If you answer Sam's question rather than tell us what it should be, then maybe we can move forward.

CodesiriuS
12-22-2016, 07:06 AM
ooops sorry I didn't make that clear. The message box displays the file path and that's exactly what it should do - however after clicking the ok button on the message box it generates an error at this line -
Set wThat = Workbooks(TextBox1.Value)[/CODE

[CODE]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)
Me.TextBox1 = SelectedFile
End If
End Sub

Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook
Set wThis = ThisWorkbook
MsgBox TextBox1.Value
Set wThat = Workbooks(TextBox1.Value)
Application.ScreenUpdating = False
Set wbOpen = Workbooks.Open(Me.TextBox1.Text)
For Each ws In wbOpen.Worksheets
Call Cleanup(ws)
Next
Application.ScreenUpdating = True
End Sub

SamT
12-22-2016, 08:43 AM
Let's expand this and put in the TextBox Value as seen in the MsgBox

Set wThat = Workbooks(TextBox1.Value)

Set wThat = Workbooks("C:\Users\wilsoel\Desktop\Sample 1.xls")

Is it possible to have an Excel Workbook With colons and backslashes in its Name? That is a Path


:banghead:




The solution, put the book's Name in the Textbox

Set wbOpen = Workbooks.Open(SelectedFile)
Me.TextBox1 = wbOpen.Name


GetFileName returns a Path, that is why you can use its Return directly when opening a file.

The Index of the Workbooks Collection Object must be Workbook.Name. (Or a number.)

CodesiriuS
12-22-2016, 06:00 PM
Man thanks Sam I really appreciate the help and for your time...that makes sense as I have seen this in other codes I have viewed - I made the update and I get an out of range error when it call the sub - the error is type mismatch

I think this is because
Call Cleanup(ws) is a worksheet but my Sub is defined as follows
Sub Cleanup(wb As Workbook)

SamT
12-22-2016, 06:44 PM
Probably. Type Mismatch means Object and Variable issues.

Subscript out of range usually means String issues.

Not always, but that's where I start looking.

After you do a thousand or so, it gets quicker to foind errors.

CodesiriuS
12-23-2016, 12:17 AM
Hey Sam last question and then I'll leave you alone I swear :)

I substituted this line
Call Cleanup(ws) because of the runtime error 13 "mismatch " with
Application.Run Cleanup argument not optional error -
Do you have any thoughts?


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)
Me.TextBox1 = wbOpen.Name
End If
End Sub

Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook
Set wThis = ThisWorkbook
MsgBox TextBox1.Value
Set wThat = Workbooks(TextBox1.Value)
Application.ScreenUpdating = False
Set wbOpen = Workbooks.Open(Me.TextBox1.Text)
For Each ws In wbOpen.Worksheets
Application.RunCleanup
Next
Application.ScreenUpdating = True
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
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

snb
12-23-2016, 01:41 AM
All you need is (never use ChDir):


sub M_snb()
with application.filedialog(1)
.initialfilename="G:\OF\*.xls*"
if .show then getobject .selecteditems(1)
end with
end sub

SamT
12-23-2016, 08:43 AM
Hey Sam last question and then I'll leave you alone I swear http://www.vbaexpress.com/forum/images/smilies/001.gif

I substituted this line

because of the runtime error 13 "mismatch " with[CODE]
Application.Run Cleanup

argument not optional error -
Do you have any thoughts?
Change

Sub Cleanup(wb As Workbook) To:

Sub Cleanup(ws As Worksheet)
And rewrite CLeanup to work on one sheet at time

OR

Change

For Each ws In wbOpen.Worksheets
Application.RunCleanup
Next To:

Cleanup wbOpen





I strongly recommend that serious students of VBA parse snb's offerings. You will learn a great deal more about how VBA really works. In the VBA Editor, press F2 for VBA details.

Then see if you can make this work

private sub CommandButton2_Click()
with Application.filedialog(1)
.initialfilename="C:\*.xls*"
if .show then Cleanup getobject .selecteditems(1)
end with
End Sub

CodesiriuS
12-27-2016, 11:42 AM
Hi Snb -

Could you let me know why ChDir is not best practice? Just curious - and trying to learn the right way to do things

CodesiriuS
12-29-2016, 08:25 AM
Hey SamT -

I just wanted to say thanks for your help with this!!!

SamT
12-29-2016, 10:52 AM
YW