Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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" wrote: 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" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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" wrote: 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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" wrote: 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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" wrote: 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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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 he 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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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 he 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 |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
Ok. This works great.
I've created this one he 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 |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: Ok. This works great. I've created this one he 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 |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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 |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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" wrote: 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" wrote: 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 |
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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 "Joel" wrote: 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 |
#18
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA - UserForm Reset Option
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 "Joel" wrote: 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 |
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import Macro
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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Reset Colors Option gone from Excel 2007? | Excel Discussion (Misc queries) | |||
Auto advance to next field -tab key AND option button to reset fie | Excel Programming | |||
reset option buttons | Excel Worksheet Functions | |||
reset option buttons | Excel Programming | |||
reset option buttons | Excel Programming |