Menu selection in excel

B

billgilmer

New Member
Joined
Dec 30, 2004
Messages
11
I have a macro / macros that that I need to run every week.
I would like to have a menu to select the file and then run the macro to format the text file.
: This is only a part of the macro I edit each week:
You can see that it repeats itself, only changing the "week and folder" their are over 5 folders per month and a 170 sub folders under each week.
:confused:Hope you can help, Thanks!!:confused:

billgilmer@satx.rr.com

Sub BG()
'
' BG Macro
' Macro recorded 12/1/2005 by Bill
'
' Keyboard Shortcut: Ctrl+k
'
Sheets("47").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;I:\CPYDPTH\05stores\Oct_5\47\totals.txt", Destination:=Range("A1"))
.Name = "totals"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 9, 16, 12, 17, 8, 8, 8)
.Refresh BackgroundQuery:=False
End With
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Columns("M:M").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=1
Columns("O:O").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 1
Columns("A:A").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("E1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Range("G1").Select
ActiveSheet.Paste
Range("I1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("K1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=3
Range("M1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("O1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Columns("O:O").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 1
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=1
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1

Sheets("932").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;I:\CPYDPTH\05stores\Oct_5\932\totals.txt", Destination:=Range("A1"))
.Name = "totals"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 9, 16, 12, 17, 8, 8, 8)
.Refresh BackgroundQuery:=False
End With
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Columns("M:M").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=1
Columns("O:O").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 1
Columns("A:A").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("E1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Range("G1").Select
ActiveSheet.Paste
Range("I1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("K1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=3
Range("M1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("O1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Columns("O:O").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 1
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=1
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Sheets("933").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;I:\CPYDPTH\05stores\Oct_5\933\totals.txt", Destination:=Range("A1"))
.Name = "totals"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 9, 16, 12, 17, 8, 8, 8)
.Refresh BackgroundQuery:=False
End With
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Columns("M:M").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=1
Columns("O:O").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 1
Columns("A:A").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("E1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Range("G1").Select
ActiveSheet.Paste
Range("I1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("K1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=3
Range("M1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("O1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Columns("O:O").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 1
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=1
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
You could use the GetOpenFilename Method to open a dialog box where the user can navigate to, and select a filename. The file won't be opened, but you can create a query based on that filename. That way, you can put the code in a loop, saving a lot of extra code.

Hope that helps!
 
Upvote 0
From the VBA help file:

Example:
This example displays the Open dialog box, with the file filter set to text files. If the user chooses a file name, the code displays that file name in a message box.

Code: 
fileToOpen = Application _
    .GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
    MsgBox "Open " & fileToOpen
End If
 
Upvote 0
Thanks You

First off I want to thank you for your help. I got it working on my computer "office2000" but, it dosn't work with "office97".
This is the macro what you help me come up with.
Thanks Again

Sub Opentotals()
'
' Opentotals Macro
' Macro recorded 12/6/2005 by Bill
'
' Keyboard Shortcut: Ctrl+b
'
fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;totals.txt", Destination:=Range("A1"))
.Name = "totals"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 9, 16, 12, 17, 8, 8, 8)
.Refresh BackgroundQuery:=False
End With
Range("C1:C600").Select
Selection.Insert Shift:=xlToRight
Range("E1:E600").Select
Selection.Insert Shift:=xlToRight
Range("G1:G600").Select
Selection.Insert Shift:=xlToRight
Range("I1:I600").Select
Selection.Insert Shift:=xlToRight
Range("K1:K600").Select
Selection.Insert Shift:=xlToRight
Range("M1:M600").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=1
Range("O1:O600").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 1
Range("A1:A600").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("E1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Range("G1").Select
ActiveSheet.Paste
Range("I1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("K1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=3
Range("M1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=1
Range("O1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=4
Columns("O:O").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 1
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=1
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=2
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Rows("3:5").Select
Selection.Delete Shift:=xlUp
Dim c As Range
Range("A1").Select

Selection.SpecialCells(xlCellTypeBlanks).Select

For Each c In Selection
If Application.WorksheetFunction.CountA(Range(c.Row & ":" & c.Row)) <> 0 Then
Else
c.EntireRow.Delete
End If
Next

Range("A1").Select

End If

End Sub
:biggrin:

My next step is the lookup table using vlookup. Their are 171 worksheets plus1 total sheet which contains the data I am looking for. The macro above is get the information for the lookup.

Thanks!!! :) :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Run-time error 9, Subscript out of range - Copying sheet from closed workbook to active workbook as new sheet
Replies
9
Views
290
dvward
D
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
478
kevin9999
K
P
  • Question
Help with Vba Code
Replies
3
Views
146
Coyotex3
C
R
  • Question
Macro not working after adding two new items
Replies
4
Views
91
myall_blues
myall_blues
G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
355
rlv01
R

Forum statistics

Threads
1,214,619
Messages
6,120,550
Members
448,970
Latest member
kennimack

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top