VBA - UserForm Reset Option

[megatron08]

Here is my Userform that I created:

Sub Import()
'
' Import Macro
' Macro recorded 08/06/2008 by christopherr
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Y:\Financial Services\FS2008\Woodworkers\ER
Reports\052008\Test\Original Weyerhaeuser.TOC May 08.200806172100086.txt" _
, Destination:=Range("A1"))
.Name = "Original Weyerhaeuser.NelsonTrust.200806172055088"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Totals"
End Sub

Private Sub CommandButton1_Click()
Import
End Sub
Sub SubTotalERCode()
'
' SubTotalERCode Macro
' Macro recorded 08/06/2008 by christopherr
'

'
Selection.Subtotal GroupBy:=14, Function:=xlCount, TotalList:=Array(14), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=-42
Columns("M:M").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=42
End Sub

Private Sub CommandButton2_Click()
SubTotalERCode
End Sub
Sub Subtotals()
'
' Subtotals Macro
' Macro recorded 08/08/2008 by christopherr
'

'
ActiveWindow.SmallScroll Down:=-63
Range("I1").Select
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(9,
10), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=81
End Sub
Private Sub CommandButton3_Click()
Subtotals
End Sub
Sub Worksheet()
'
' WorkSheet Macro
' Macro recorded 08/06/2008 by christopherr
'

'
Range("A2:N65").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Columns("E:E").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Sheets("Totals").Select
Application.CutCopyMode = False
End Sub

So macro sub Worksheet is selecting the data in range A2:A65.

I would like to have my user manually select the data range within the user
form.

I've researched this thread hoping to find similar suggestions/ideas, but
found none which is why I'm sending this request.

TIA
~Christopher

 

[Joel]

You need to use an inputbox with option 8. Here is the VBA help instructions

If Type is 8, InputBox returns a Range object. You must use the Set
statement to assign the result to a Range object, as shown in the following
example.

Set myRange = Application.InputBox(prompt := "Sample", type := 8)
If you don't use the Set statement, the variable is set to the value in the
range, rather than the Range object itself.

 

[megatron08]

Hi Joel,

So with the code that you listed below do I just insert into my macro named
sub worksheet?

I tried reviewing the code and couldn't find option 8.

Any suggestions/ideas would be great.

TIA
~Christopher

 

[Joel]

I don't like using recorded macro without making changes. The recorded
macros use "Selection". I pefer to specify Worksheet names and Ranges.

Set myRange = Application.InputBox(prompt := "Sample", type := 8)
with Sheets("Sheet2")
MyRange.Copy
.Paste 'really shoud have a range here. Can cause errors.
.Columns("E:E").EntireColumn.AutoFit
.Columns("H:H").EntireColumn.AutoFit
.Columns("A:A").EntireColumn.AutoFit
end with

Here is my modifed code with your amcro

Sub Worksheet()
'
' WorkSheet Macro
' Macro recorded 08/06/2008 by christopherr
'

'
Set myRange = Application.InputBox(prompt := "Sample", type := 8)
MyRange.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Columns("E:E").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Sheets("Totals").Select
Application.CutCopyMode = False
End Sub

 

[megatron08]

Thanks this is what I needed.

Can I create an Application.InputBox to prompt the user to find a file like
in the following macro? Is it even possible?

Sub Import()
'
' Import Macro
' Macro recorded 08/06/2008 by christopherr
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Y:\Financial Services\FS2008\Woodworkers\ER
Reports\052008\Test\Original Weyerhaeuser.TOC May 08.200806172100086.txt" _
, Destination:=Range("A1"))
.Name = "Original Weyerhaeuser.NelsonTrust.200806172055088"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Totals"
End Sub

Any suggestions/ideas would be great.

TIA
~Christopher

 

[Joel]

There are towo functions shown below. The difference is the OPEN method
insists on a pre-existing file and the SAVEAS allows you to use either a
pre-existing filename or a new file name. Both return a Fullpathname along
with the filename.

fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.txt), *.txt")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If

fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If

 

[megatron08]

Ok. I think that is what I had in mind before.

Since you provided me with the code for the Application.inbox script, is
there a way to re-set it so that my user can copy the data onto another
sheet, after the selection has been made?

I tested the code, but it look like it only copies the selected cells into
sheet2.

An example would: Select cells A2-A25 paste into sheet2

Then select cells B2-B25 paste into sheet3 and so on.

Any suggestions/ideas would be great.

TIA
~Christopher

 

[Joel]

Try this

Sub test()

fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName = False Then
MsgBox "Cannnot Open file, Exit Sub"
Exit Sub
End If

Set NewBk = Workbooks.Add
NewBk.SaveAs Filename:=fileSaveName

Do
With NewBk
Set NewSht = .Sheets.Add(after:=.Sheets(.Sheets.Count))

Set MyRange = Application.InputBox(prompt:="Sample", Type:=8)
With Sheets("Sheet2")
MyRange.Copy Destination:=NewSht.Range("A1")
.Columns("E:E").EntireColumn.AutoFit
.Columns("H:H").EntireColumn.AutoFit
.Columns("A:A").EntireColumn.AutoFit
End With
End With
Response = MsgBox("do you want to copy another Range", vbYesNo)

Loop While Response = vbYes

NewBk.Close savechanges:=True

End Sub

 

[megatron08]

Hi Joel,

Any ideas of making the code below included into the following:

Sub Import()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Y:\Financial Services\FS2008\Woodworkers\ER
Reports\052008\Test\Original Weyerhaeuser.TOC May 08.200806172100086.txt" _
, Destination:=Range("A1"))
.Name = "Original Weyerhaeuser.NelsonTrust.200806172055088"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Totals"
End Sub

Private Sub CommandButton1_Click()
Import
End Sub
Sub SubTotalERCode()
Selection.Subtotal GroupBy:=14, Function:=xlCount, TotalList:=Array(14), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=-42
Columns("M:M").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=42
End Sub
Private Sub CommandButton2_Click()
SubTotalERCode
End Sub
Sub Subtotals()
ActiveWindow.SmallScroll Down:=-63
Range("I1").Select
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(9,
10), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=81
End Sub
Private Sub CommandButton3_Click()
Subtotals
End Sub
Sub Worksheet()
Set MyRange = Application.InputBox(prompt:="Selectcells", Type:=8)
MyRange.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Columns("E:E").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Application.CutCopyMode = False
End Sub

I'd like the sub Worksheet macro to be able to just take the existing
information from sheet1 and copy into sheet2, then reset and then add into
another new sheet as opposed to another different workbook.

TIA
~Christopher

 

[Joel]

Sub Worksheet()
Set MyRange = Application.InputBox(prompt:="Selectcells", Type:=8)
set NewSht = sheets.add(after:=sheets(sheets.count))
with NewSht
MyRange.Copy destination:=.Range("A1")
.Columns("E:E").EntireColumn.AutoFit
.Columns("H:H").EntireColumn.AutoFit
.Columns("A:A").EntireColumn.AutoFit
end with
Application.CutCopyMode = False
End Sub

 

[megatron08]

It worked. So I'm assuming that I can proceed with using the same code going
forward.

The following code that I created using a recorded macro here:

Sub Import()

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Y:\Financial Services\FS2008\Woodworkers\ER
Reports\052008\Test\Original Weyerhaeuser.TOC May 08.200806172100086.txt" _
, Destination:=Range("A1"))
.Name = "Original Weyerhaeuser.NelsonTrust.200806172055088"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Totals"
End Sub

Is there code that can prompt the user to select the location of the file
prior to doing the import of the .txt file? I'd like to use the same
subroutine if it is added.

TIA
~Christopher

 

[Joel]

Try this. I made some minor changes to the recorded section to insure it
would work. There are some odd-ball problems with recorded macros that cause
errors. then I made the changes to accept a variable filename. I had some
problems in the past when the filename and the Base name didn't match soem I
made sure they will always match. See changes below.

Sub Import()

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen = False Then
MsgBox "Cannot Open file - Exiting sub"
Exit Sub
End If

BaseName = fileToOpen
'remove path from filename
Do While InStr(BaseName, "\") > 0
BaseName = Mid(BaseName, InStr(BaseName, "\") + 1)
Loop
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & fileToOpen, _
Destination:=Range("A1"))


.Name = BaseName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Totals"
End Sub

 

[megatron08]

Ok. This works great.

I've created this one here:

Sub Export2CSV()
ChDir _
"Y:\Financial Services\FS2008\Woodworkers\ER
Reports\082008\Nelsontrust"
ActiveWorkbook.SaveAs Filename:= _
"Y:\Financial Services\FS2008\Woodworkers\ER
Reports\082008\Nelsontrust\WW55101.csv" _
, FileFormat:=xlCSV, CreateBackup:=False
End Sub

How do I go about putting the selected worksheet and save it using a
different .csv name? Everytime I attempt to run the macro is keeps error
out. I'm thinking it is because of the name of the csv file is already in the
code, but need assistance on having the user change it instead.

TIA
~Christopher

 

[Joel]

this code works for me. You will get an error if the folder doesn't exist.

Sub Export2CSV()

folder = "Y:\Financial Services\FS2008\Woodworkers\" & _
"ER Reports\082008\Nelsontrust\"
Book = "WW55101.csv"
ActiveWorkbook.SaveAs Filename:=folder & Book, _
FileFormat:=xlCSV, CreateBackup:=False
End Sub


Sub Export2CSV()

Folder = "Y:\Financial Services\FS2008\Woodworkers\" & _
ER Reports\082008\Nelsontrust\"
ActiveWorkbook.SaveAs Filename:= Folder & "WW55101.csv", _
FileFormat:=xlCSV, CreateBackup:=False
End Sub

 

[megatron08]

Hi Joel,

Can the code be modified so that the user is prompt to save the worksheet
while it exports the selected worksheet into a .csv?

The code that I created looks like it is taking the entire workbook and then
saving and exporting into a .csv.

My current work around is to save the workbook as a different name prior to
the Export2CSV being ran.

TIA
~Christopher

 

[Joel]

Next time you have a question post all the code. We have addressed many
problems and it is hard for me to figure out which previous posted code you
were refering to and which version of the code you wanted modified. I tried
my best to get the code correct.

The code below prompts for a filename, then sames the file as an XLS file
using the prompted name, and then save the file again under the same name but
as a CSV file. The file file which is opened will be an Excel CSV. The CSV
file will not have any macros since it is just TEXT. CSV files can be opend
using Notepad. If you never have opened a CSV file with notepad you should.

Sub Export2CSV()

fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName = False Then
MsgBox ("Cannot Save file - Exiting Macro")
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=fileSaveName
ActiveWorkbook.SaveAs FileFormat:=xlCSV

End Sub

 

[megatron08]

Thanks this will work. I wasn't sure if you wanted the whole entire code or
just the sub code that I created. I completely understand wanting the whole
code so that everything is consistent.

Do you know or recommend any books or websites besides this one that can
help me more w/VB?

TIA
~Christopher

 

[megatron08]

Hi Joel,

Is there a way to made the following userform: TestingUserForm to prompt
them to use the form when they open excel? They don't want o hit Alt + F11.

TIA
~Christopher

Here is the Userform:

Private Sub CommandButton1_Click()
Import
End Sub
Sub SubTotalERCode()
Selection.Subtotal GroupBy:=14, Function:=xlCount, TotalList:=Array(14), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=-42
Columns("M:M").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=42
End Sub
Private Sub CommandButton2_Click()
SubTotalERCode
End Sub
Sub Subtotals()
ActiveWindow.SmallScroll Down:=-63
Range("I1").Select
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(9,
10), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=81
End Sub
Private Sub CommandButton3_Click()
Subtotals
End Sub
Sub Worksheet()
Set MyRange = Application.InputBox(prompt:="Selectcells", Type:=8)
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
With NewSht
MyRange.Copy Destination:=.Range("A1")
..Columns("E:E").EntireColumn.AutoFit
..Columns("H:H").EntireColumn.AutoFit
..Columns("A:A").EntireColumn.AutoFit
End With
Application.CutCopyMode = False
End Sub
Private Sub CommandButton4_Click()
Worksheet
End Sub
Sub Export2CSV()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName = False Then
MsgBox ("Cannot Save file - Exiting Macro")
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=fileSaveName
ActiveWorkbook.SaveAs FileFormat:=xlCSV

End Sub
Private Sub CommandButton5_Click()
Export2CSV
End Sub

Range("A1:N1958").Sort Key1:=Range("N1"), Order1:=xlAscending, Key2:= _
Range("I2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:= _
xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
End Sub

Private Sub CommandButton6_Click()
Sortdata
End Sub

Private Sub Exportfile_Click()
Export2CSV
End Sub

Private Sub Sortdata_Click()
Range("A1:N1958").Sort Key1:=Range("N2"), Order1:=xlAscending, Key2:= _
Range("I2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:= _
xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
End Sub

Private Sub Sortpreviousmonths_Click()
Columns("A:N").Select
Range("N1").Activate
Selection.Sort Key1:=Range("M2"), Order1:=xlAscending, Key2:=Range("N2") _
, Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Range("O2").Select
End Sub

Private Sub UserForm_Click()
Import
End Sub

 

[Tony A]

This macro works well and thank you for developing it. I wanted to make one alteration, but I don't know how. Do you know how I can use the macro to import excel file instead of text?

Thank you in advance.