+ Reply to Thread
Results 1 to 10 of 10

Repeat macro for all open workbooks

  1. #1
    Guest

    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 = "***"
    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).EntireRow.Delete
    ActiveSheet.UsedRange 'Resets UsedRange for Excel 97

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


    ' = = = = = = = = = = = = = = = =
    ' Use of CDbl suggested by Peter Surcouf
    ' Program by Dana DeLouis, [email protected]
    ' = = = = = = = = = = = = = = = =
    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.



  2. #2
    NickHK
    Guest

    Re: Repeat macro for all open workbooks

    Andy,
    Look at the last argument for GetOpenFilename; MultiSelect.
    If this is True then an array of filenames is returned, even if only one
    file is selected.

    So you need wrap your whole "massage" code in a loop
    'Check if the array is 1 or 0 based, can't remember
    Dim SourceWB As Workbook
    For i =1 to UBound(MySelectedFiles)
    Set SourceWB = Workbooks.OpenText (MySelectedFiles(i),,,,,,)
    ..........
    Next

    Also, there's no need to do all those .Selects. Something like:
    With SourceWB.Worksheet(1).Range("A1")
    .Offset(0,1).Value= "REF"
    .Offset(0,2).Value= "DESC"
    ...................

    And move all your Dims out of all loops.

    NickHK


    <Andy> wrote in message news:[email protected]...
    > 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 = "***"
    > 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).EntireRow.Delete
    > ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >
    > On Error Resume Next ' In case there are no blanks
    > Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    > ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >
    >
    > ' = = = = = = = = = = = = = = = =
    > ' Use of CDbl suggested by Peter Surcouf
    > ' Program by Dana DeLouis, [email protected]
    > ' = = = = = = = = = = = = = = = =
    > 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.
    >
    >




  3. #3
    Bob Phillips
    Guest

    Re: Repeat macro for all open workbooks

    You need to wrap the code in say


    Dim oWB As Workbook

    For Each oWB In Workbooks

    .... your code

    Next oWB

    then in your code when you refer to activeworkbook, such as

    For Each wks In ActiveWorkbook.Worksheets

    You need to refer to the workbook object

    For Each wks In oWB.Worksheets

    --
    HTH

    Bob Phillips

    (remove nothere from email address if mailing direct)

    <Andy> wrote in message news:[email protected]...
    > 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 = "***"
    > 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).EntireRow.Delete
    > ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >
    > On Error Resume Next ' In case there are no blanks
    > Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    > ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >
    >
    > ' = = = = = = = = = = = = = = = =
    > ' Use of CDbl suggested by Peter Surcouf
    > ' Program by Dana DeLouis, [email protected]
    > ' = = = = = = = = = = = = = = = =
    > 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.
    >
    >




  4. #4
    Guest

    Re: Repeat macro for all open workbooks

    Thanks Bob. The problem is that the macro imports a text file at the
    beginning. Is it possible for me to select several files for it to import
    on, rather than just the one (or for it to import all of the files in a
    folder)?
    I can probably suss out how to loop the macro once the files have been
    opened in Excel - it's just getting to that point that is the problem!
    Cheers.
    Andy.

    "Bob Phillips" <[email protected]> wrote in message
    news:[email protected]...
    > You need to wrap the code in say
    >
    >
    > Dim oWB As Workbook
    >
    > For Each oWB In Workbooks
    >
    > .... your code
    >
    > Next oWB
    >
    > then in your code when you refer to activeworkbook, such as
    >
    > For Each wks In ActiveWorkbook.Worksheets
    >
    > You need to refer to the workbook object
    >
    > For Each wks In oWB.Worksheets
    >
    > --
    > HTH
    >
    > Bob Phillips
    >
    > (remove nothere from email address if mailing direct)
    >
    > <Andy> wrote in message news:[email protected]...
    >> 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 = "***"
    >> 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).EntireRow.Delete
    >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >>
    >> On Error Resume Next ' In case there are no blanks
    >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >>
    >>
    >> ' = = = = = = = = = = = = = = = =
    >> ' Use of CDbl suggested by Peter Surcouf
    >> ' Program by Dana DeLouis, [email protected]
    >> ' = = = = = = = = = = = = = = = =
    >> 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.
    >>
    >>

    >
    >




  5. #5
    NickHK
    Guest

    Re: Repeat macro for all open workbooks

    Andy,
    Did you see my post about the last argument to GetOpenFilename ?
    Hint; MultiSelect=True.

    NickHK

    <Andy> wrote in message news:[email protected]...
    > Thanks Bob. The problem is that the macro imports a text file at the
    > beginning. Is it possible for me to select several files for it to import
    > on, rather than just the one (or for it to import all of the files in a
    > folder)?
    > I can probably suss out how to loop the macro once the files have been
    > opened in Excel - it's just getting to that point that is the problem!
    > Cheers.
    > Andy.
    >
    > "Bob Phillips" <[email protected]> wrote in message
    > news:[email protected]...
    > > You need to wrap the code in say
    > >
    > >
    > > Dim oWB As Workbook
    > >
    > > For Each oWB In Workbooks
    > >
    > > .... your code
    > >
    > > Next oWB
    > >
    > > then in your code when you refer to activeworkbook, such as
    > >
    > > For Each wks In ActiveWorkbook.Worksheets
    > >
    > > You need to refer to the workbook object
    > >
    > > For Each wks In oWB.Worksheets
    > >
    > > --
    > > HTH
    > >
    > > Bob Phillips
    > >
    > > (remove nothere from email address if mailing direct)
    > >
    > > <Andy> wrote in message news:[email protected]...
    > >> 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 = "***"
    > >> 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).EntireRow.Delete
    > >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    > >>
    > >> On Error Resume Next ' In case there are no blanks
    > >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    > >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    > >>
    > >>
    > >> ' = = = = = = = = = = = = = = = =
    > >> ' Use of CDbl suggested by Peter Surcouf
    > >> ' Program by Dana DeLouis, [email protected]
    > >> ' = = = = = = = = = = = = = = = =
    > >> 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.
    > >>
    > >>

    > >
    > >

    >
    >




  6. #6
    Guest

    Re: Repeat macro for all open workbooks

    Nick
    Thanks for your reply. I didn't spot that last time, sorry. I'm not all that
    hot on macros, so I'm struggling - a bit out of my depth. I'm just trying to
    ease the job of dissecting a year's till files. Bear with me!

    Cheers.
    Andy.

    "NickHK" <[email protected]> wrote in message
    news:[email protected]...
    > Andy,
    > Did you see my post about the last argument to GetOpenFilename ?
    > Hint; MultiSelect=True.
    >
    > NickHK
    >
    > <Andy> wrote in message news:[email protected]...
    >> Thanks Bob. The problem is that the macro imports a text file at the
    >> beginning. Is it possible for me to select several files for it to import
    >> on, rather than just the one (or for it to import all of the files in a
    >> folder)?
    >> I can probably suss out how to loop the macro once the files have been
    >> opened in Excel - it's just getting to that point that is the problem!
    >> Cheers.
    >> Andy.
    >>
    >> "Bob Phillips" <[email protected]> wrote in message
    >> news:[email protected]...
    >> > You need to wrap the code in say
    >> >
    >> >
    >> > Dim oWB As Workbook
    >> >
    >> > For Each oWB In Workbooks
    >> >
    >> > .... your code
    >> >
    >> > Next oWB
    >> >
    >> > then in your code when you refer to activeworkbook, such as
    >> >
    >> > For Each wks In ActiveWorkbook.Worksheets
    >> >
    >> > You need to refer to the workbook object
    >> >
    >> > For Each wks In oWB.Worksheets
    >> >
    >> > --
    >> > HTH
    >> >
    >> > Bob Phillips
    >> >
    >> > (remove nothere from email address if mailing direct)
    >> >
    >> > <Andy> wrote in message news:[email protected]...
    >> >> 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 = "***"
    >> >> 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).EntireRow.Delete
    >> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >> >>
    >> >> On Error Resume Next ' In case there are no blanks
    >> >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    >> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >> >>
    >> >>
    >> >> ' = = = = = = = = = = = = = = = =
    >> >> ' Use of CDbl suggested by Peter Surcouf
    >> >> ' Program by Dana DeLouis, [email protected]
    >> >> ' = = = = = = = = = = = = = = = =
    >> >> 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.
    >> >>
    >> >>
    >> >
    >> >

    >>
    >>

    >
    >




  7. #7
    Guest

    Re: Repeat macro for all open workbooks

    Hi Nick

    Here is the beginning of my macro now:
    '
    ' 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?",
    MultiSelect:=True)


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

    Dim rng As Range
    Dim bigrng As Range
    Dim SourceWB As Workbook
    For i = 1 To UBound(MySelectedFiles)
    Set SourceWB = Workbooks.OpenText(MySelectedFiles(i), 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


    I get an error when I run it on the Set SourceWB line and OpenText is
    highlighted. It says 'Compile Error - Expected function or variable'
    Thanks for your help.
    Andy.


    <Andy> wrote in message news:[email protected]...
    > Nick
    > Thanks for your reply. I didn't spot that last time, sorry. I'm not all
    > that hot on macros, so I'm struggling - a bit out of my depth. I'm just
    > trying to ease the job of dissecting a year's till files. Bear with me!
    >
    > Cheers.
    > Andy.
    >
    > "NickHK" <[email protected]> wrote in message
    > news:[email protected]...
    >> Andy,
    >> Did you see my post about the last argument to GetOpenFilename ?
    >> Hint; MultiSelect=True.
    >>
    >> NickHK
    >>
    >> <Andy> wrote in message news:[email protected]...
    >>> Thanks Bob. The problem is that the macro imports a text file at the
    >>> beginning. Is it possible for me to select several files for it to
    >>> import
    >>> on, rather than just the one (or for it to import all of the files in a
    >>> folder)?
    >>> I can probably suss out how to loop the macro once the files have been
    >>> opened in Excel - it's just getting to that point that is the problem!
    >>> Cheers.
    >>> Andy.
    >>>
    >>> "Bob Phillips" <[email protected]> wrote in message
    >>> news:[email protected]...
    >>> > You need to wrap the code in say
    >>> >
    >>> >
    >>> > Dim oWB As Workbook
    >>> >
    >>> > For Each oWB In Workbooks
    >>> >
    >>> > .... your code
    >>> >
    >>> > Next oWB
    >>> >
    >>> > then in your code when you refer to activeworkbook, such as
    >>> >
    >>> > For Each wks In ActiveWorkbook.Worksheets
    >>> >
    >>> > You need to refer to the workbook object
    >>> >
    >>> > For Each wks In oWB.Worksheets
    >>> >
    >>> > --
    >>> > HTH
    >>> >
    >>> > Bob Phillips
    >>> >
    >>> > (remove nothere from email address if mailing direct)
    >>> >
    >>> > <Andy> wrote in message news:[email protected]...
    >>> >> 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 = "***"
    >>> >> 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).EntireRow.Delete
    >>> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >>> >>
    >>> >> On Error Resume Next ' In case there are no blanks
    >>> >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    >>> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >>> >>
    >>> >>
    >>> >> ' = = = = = = = = = = = = = = = =
    >>> >> ' Use of CDbl suggested by Peter Surcouf
    >>> >> ' Program by Dana DeLouis, [email protected]
    >>> >> ' = = = = = = = = = = = = = = = =
    >>> >> 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.
    >>> >>
    >>> >>
    >>> >
    >>> >
    >>>
    >>>

    >>
    >>

    >
    >




  8. #8
    Bob Phillips
    Guest

    Re: Repeat macro for all open workbooks

    Just add a GetOpenFilename when opening the textfile within that loop rather
    than open by name.

    --
    HTH

    Bob Phillips

    (remove nothere from email address if mailing direct)

    <Andy> wrote in message news:[email protected]...
    > Thanks Bob. The problem is that the macro imports a text file at the
    > beginning. Is it possible for me to select several files for it to import
    > on, rather than just the one (or for it to import all of the files in a
    > folder)?
    > I can probably suss out how to loop the macro once the files have been
    > opened in Excel - it's just getting to that point that is the problem!
    > Cheers.
    > Andy.
    >
    > "Bob Phillips" <[email protected]> wrote in message
    > news:[email protected]...
    > > You need to wrap the code in say
    > >
    > >
    > > Dim oWB As Workbook
    > >
    > > For Each oWB In Workbooks
    > >
    > > .... your code
    > >
    > > Next oWB
    > >
    > > then in your code when you refer to activeworkbook, such as
    > >
    > > For Each wks In ActiveWorkbook.Worksheets
    > >
    > > You need to refer to the workbook object
    > >
    > > For Each wks In oWB.Worksheets
    > >
    > > --
    > > HTH
    > >
    > > Bob Phillips
    > >
    > > (remove nothere from email address if mailing direct)
    > >
    > > <Andy> wrote in message news:[email protected]...
    > >> 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 = "***"
    > >> 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).EntireRow.Delete
    > >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    > >>
    > >> On Error Resume Next ' In case there are no blanks
    > >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    > >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    > >>
    > >>
    > >> ' = = = = = = = = = = = = = = = =
    > >> ' Use of CDbl suggested by Peter Surcouf
    > >> ' Program by Dana DeLouis, [email protected]
    > >> ' = = = = = = = = = = = = = = = =
    > >> 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.
    > >>
    > >>

    > >
    > >

    >
    >




  9. #9
    Guest

    Re: Repeat macro for all open workbooks

    Nick

    I now get a Type Mismatch error.
    I get the dialog box to select the files but when I click Open, I get the
    error. I've tried the Cancel button from the dialog box and it exits OK so
    I'm guessing it must be the section starting with:

    Dim rng As Range
    Dim bigrng As Range
    Dim SourceWB As Workbook
    For i = 1 To UBound(MySelectedFiles)
    Set SourceWB = Workbook.OpenText(Filename:=MySelectedFiles(i),
    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


    Thanks for your help - again!
    Cheers.
    Andy.
    <Andy> wrote in message news:[email protected]...
    > Hi Nick
    >
    > Here is the beginning of my macro now:
    > '
    > ' 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?",
    > MultiSelect:=True)
    >
    >
    > If myfile = False Then
    > 'you pressed cancel
    > MsgBox "Ok. Quitting"
    > Exit Sub
    > End If
    >
    > Dim rng As Range
    > Dim bigrng As Range
    > Dim SourceWB As Workbook
    > For i = 1 To UBound(MySelectedFiles)
    > Set SourceWB = Workbooks.OpenText(MySelectedFiles(i), 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
    >
    >
    > I get an error when I run it on the Set SourceWB line and OpenText is
    > highlighted. It says 'Compile Error - Expected function or variable'
    > Thanks for your help.
    > Andy.
    >
    >
    > <Andy> wrote in message news:[email protected]...
    >> Nick
    >> Thanks for your reply. I didn't spot that last time, sorry. I'm not all
    >> that hot on macros, so I'm struggling - a bit out of my depth. I'm just
    >> trying to ease the job of dissecting a year's till files. Bear with me!
    >>
    >> Cheers.
    >> Andy.
    >>
    >> "NickHK" <[email protected]> wrote in message
    >> news:[email protected]...
    >>> Andy,
    >>> Did you see my post about the last argument to GetOpenFilename ?
    >>> Hint; MultiSelect=True.
    >>>
    >>> NickHK
    >>>
    >>> <Andy> wrote in message news:[email protected]...
    >>>> Thanks Bob. The problem is that the macro imports a text file at the
    >>>> beginning. Is it possible for me to select several files for it to
    >>>> import
    >>>> on, rather than just the one (or for it to import all of the files in a
    >>>> folder)?
    >>>> I can probably suss out how to loop the macro once the files have been
    >>>> opened in Excel - it's just getting to that point that is the problem!
    >>>> Cheers.
    >>>> Andy.
    >>>>
    >>>> "Bob Phillips" <[email protected]> wrote in message
    >>>> news:[email protected]...
    >>>> > You need to wrap the code in say
    >>>> >
    >>>> >
    >>>> > Dim oWB As Workbook
    >>>> >
    >>>> > For Each oWB In Workbooks
    >>>> >
    >>>> > .... your code
    >>>> >
    >>>> > Next oWB
    >>>> >
    >>>> > then in your code when you refer to activeworkbook, such as
    >>>> >
    >>>> > For Each wks In ActiveWorkbook.Worksheets
    >>>> >
    >>>> > You need to refer to the workbook object
    >>>> >
    >>>> > For Each wks In oWB.Worksheets
    >>>> >
    >>>> > --
    >>>> > HTH
    >>>> >
    >>>> > Bob Phillips
    >>>> >
    >>>> > (remove nothere from email address if mailing direct)
    >>>> >
    >>>> > <Andy> wrote in message news:[email protected]...
    >>>> >> 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 = "***"
    >>>> >> 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).EntireRow.Delete
    >>>> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >>>> >>
    >>>> >> On Error Resume Next ' In case there are no blanks
    >>>> >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    >>>> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    >>>> >>
    >>>> >>
    >>>> >> ' = = = = = = = = = = = = = = = =
    >>>> >> ' Use of CDbl suggested by Peter Surcouf
    >>>> >> ' Program by Dana DeLouis, [email protected]
    >>>> >> ' = = = = = = = = = = = = = = = =
    >>>> >> 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.
    >>>> >>
    >>>> >>
    >>>> >
    >>>> >
    >>>>
    >>>>
    >>>
    >>>

    >>
    >>

    >
    >




  10. #10
    Dave Peterson
    Guest

    Re: Repeat macro for all open workbooks

    Watch your variables. Sometimes you use MyFile and other times, it was
    mySelectedfiles.

    This might get you closer:

    Option Explicit
    Sub testme01()
    Dim myfile As Variant
    Dim rng As Range
    Dim bigrng As Range
    Dim SourceWB As Workbook
    Dim i As Long

    '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?", MultiSelect:=True)

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

    For i = LBound(myfile) To UBound(myfile)
    Workbooks.OpenText Filename:=myfile(i), 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))

    Set SourceWB = ActiveWorkbook

    With SourceWB.Worksheets(1)
    .Cells.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
    HEADER:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
    End With
    Next i

    End Sub

    Although, if I knew the data, I wouldn't let excel guess at whether it contained
    a header (for the sort). I'd just tell excel in the code.

    Andy wrote:
    >
    > Nick
    >
    > I now get a Type Mismatch error.
    > I get the dialog box to select the files but when I click Open, I get the
    > error. I've tried the Cancel button from the dialog box and it exits OK so
    > I'm guessing it must be the section starting with:
    >
    > Dim rng As Range
    > Dim bigrng As Range
    > Dim SourceWB As Workbook
    > For i = 1 To UBound(MySelectedFiles)
    > Set SourceWB = Workbook.OpenText(Filename:=MySelectedFiles(i),
    > 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
    >
    > Thanks for your help - again!
    > Cheers.
    > Andy.
    > <Andy> wrote in message news:[email protected]...
    > > Hi Nick
    > >
    > > Here is the beginning of my macro now:
    > > '
    > > ' 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?",
    > > MultiSelect:=True)
    > >
    > >
    > > If myfile = False Then
    > > 'you pressed cancel
    > > MsgBox "Ok. Quitting"
    > > Exit Sub
    > > End If
    > >
    > > Dim rng As Range
    > > Dim bigrng As Range
    > > Dim SourceWB As Workbook
    > > For i = 1 To UBound(MySelectedFiles)
    > > Set SourceWB = Workbooks.OpenText(MySelectedFiles(i), 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
    > >
    > >
    > > I get an error when I run it on the Set SourceWB line and OpenText is
    > > highlighted. It says 'Compile Error - Expected function or variable'
    > > Thanks for your help.
    > > Andy.
    > >
    > >
    > > <Andy> wrote in message news:[email protected]...
    > >> Nick
    > >> Thanks for your reply. I didn't spot that last time, sorry. I'm not all
    > >> that hot on macros, so I'm struggling - a bit out of my depth. I'm just
    > >> trying to ease the job of dissecting a year's till files. Bear with me!
    > >>
    > >> Cheers.
    > >> Andy.
    > >>
    > >> "NickHK" <[email protected]> wrote in message
    > >> news:[email protected]...
    > >>> Andy,
    > >>> Did you see my post about the last argument to GetOpenFilename ?
    > >>> Hint; MultiSelect=True.
    > >>>
    > >>> NickHK
    > >>>
    > >>> <Andy> wrote in message news:[email protected]...
    > >>>> Thanks Bob. The problem is that the macro imports a text file at the
    > >>>> beginning. Is it possible for me to select several files for it to
    > >>>> import
    > >>>> on, rather than just the one (or for it to import all of the files in a
    > >>>> folder)?
    > >>>> I can probably suss out how to loop the macro once the files have been
    > >>>> opened in Excel - it's just getting to that point that is the problem!
    > >>>> Cheers.
    > >>>> Andy.
    > >>>>
    > >>>> "Bob Phillips" <[email protected]> wrote in message
    > >>>> news:[email protected]...
    > >>>> > You need to wrap the code in say
    > >>>> >
    > >>>> >
    > >>>> > Dim oWB As Workbook
    > >>>> >
    > >>>> > For Each oWB In Workbooks
    > >>>> >
    > >>>> > .... your code
    > >>>> >
    > >>>> > Next oWB
    > >>>> >
    > >>>> > then in your code when you refer to activeworkbook, such as
    > >>>> >
    > >>>> > For Each wks In ActiveWorkbook.Worksheets
    > >>>> >
    > >>>> > You need to refer to the workbook object
    > >>>> >
    > >>>> > For Each wks In oWB.Worksheets
    > >>>> >
    > >>>> > --
    > >>>> > HTH
    > >>>> >
    > >>>> > Bob Phillips
    > >>>> >
    > >>>> > (remove nothere from email address if mailing direct)
    > >>>> >
    > >>>> > <Andy> wrote in message news:[email protected]...
    > >>>> >> 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 = "***"
    > >>>> >> 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).EntireRow.Delete
    > >>>> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    > >>>> >>
    > >>>> >> On Error Resume Next ' In case there are no blanks
    > >>>> >> Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    > >>>> >> ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
    > >>>> >>
    > >>>> >>
    > >>>> >> ' = = = = = = = = = = = = = = = =
    > >>>> >> ' Use of CDbl suggested by Peter Surcouf
    > >>>> >> ' Program by Dana DeLouis, [email protected]
    > >>>> >> ' = = = = = = = = = = = = = = = =
    > >>>> >> 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.
    > >>>> >>
    > >>>> >>
    > >>>> >
    > >>>> >
    > >>>>
    > >>>>
    > >>>
    > >>>
    > >>
    > >>

    > >
    > >


    --

    Dave Peterson

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1