LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
No Name
 
Posts: n/a
Default Repeat macro for all open workbooks

Hi
Thanks for reading this!
I've been purloining bits of code from various posts - and also used the
macro recorder to come up with this:
Sub TillFileImport()
'
' Macro1 Macro
' Macro recorded 20/02/2006 by Andy
'

'
Dim myfile As Variant


'if you know the drive and folder:
'otherwise, just let the user point and click
ChDrive "C"
ChDir "C:\Documents and Settings\Andy\Desktop"


myfile = Application.GetOpenFilename(filefilter:="*.txt, (*.txt)", _
Title:="What File?")


If myfile = False Then
'you pressed cancel
MsgBox "Ok. Quitting"
Exit Sub
End If

Workbooks.OpenText Filename:=myfile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(8, _
1), Array(9, 1), Array(42, 1), Array(49, 1), Array(59, 1), Array(67,
1), Array(78, 1), Array _
(82, 1), Array(87, 1), Array(91, 1), Array(96, 1), Array(102, 1))
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, HEADER:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'remove rows with text values in column A
Application.ScreenUpdating = False
On Error Resume Next
Columns("A:A").SpecialCells(xlCellTypeConstants, 2) _
.EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True


Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "SKU"
Rows("1:1").Select
Range("B1").Activate
ActiveCell.FormulaR1C1 = "REF"
Range("C1").Select
ActiveCell.FormulaR1C1 = "DESC"
Range("D1").Select
ActiveCell.FormulaR1C1 = "QTY"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PRICE"
Range("F1").Select
ActiveCell.FormulaR1C1 = "DISC"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Range("H1").Select
ActiveCell.FormulaR1C1 = "TRANS"
Range("I1").Select
ActiveCell.FormulaR1C1 = "ASS"
Range("J1").Select
ActiveCell.FormulaR1C1 = "TILL"
Range("K1").Select
ActiveCell.FormulaR1C1 = "TIME"
Range("L1").Select
ActiveCell.FormulaR1C1 = "GP%"
Range("M1").Select
ActiveCell.FormulaR1C1 = "REF2"
Range("L1").Select


On Error Resume Next ' In case there are no blanks
Columns("A:A").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97

On Error Resume Next ' In case there are no blanks
Columns("C:C").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97


' = = = = = = = = = = = = = = = =
' Use of CDbl suggested by Peter Surcouf
' Program by Dana DeLouis,
' = = = = = = = = = = = = = = = =
Dim rng As Range
Dim bigrng As Range


On Error Resume Next
Set bigrng = Cells.SpecialCells(xlConstants, xlTextValues).Cells
If bigrng Is Nothing Then Exit Sub


For Each rng In bigrng.Cells
rng = CDbl(rng)
Next

'Reset used range
Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range

For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0

If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks

End Sub

Basically, it asks for a text file and mashes it about so it is useable. If
possible I would like this to run on every open workbook, rather than ask
for a specific file. I would like to be able to open a dozen text files and
hit the button for this to run on all of them.
Thanks for your help - whoever you may be!
Cheers.
Andy.


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Run Macro In All Open Workbooks Chacky Excel Discussion (Misc queries) 2 August 6th 08 09:34 AM
Macro to merge open workbooks Barry McConnell Excel Discussion (Misc queries) 1 August 23rd 06 05:09 PM
Macro to open all linked workbooks pkley[_2_] Excel Programming 0 October 7th 04 05:23 AM
Open two new workbooks with macro Jerry H Excel Programming 4 May 2nd 04 09:12 PM
help with macro to open and close workbooks aneurin Excel Programming 1 September 24th 03 02:14 AM


All times are GMT +1. The time now is 11:49 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"