Macro to loop through files

pboltonchina

pboltonchina

Well-known Member
Joined
Apr 24, 2008
Messages
1,104
Hi Everyone,
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
I’m running a macro that uses an Input Box for a number and then loads that *.ped file, the macro runs, saves the file to the same folder as an Excel workbook and then asks for the next number. The default folder is always the same as in the macro, H:\SAP Imports\ and then the file name. Would it possible to change my present code so that instead of the macro asking for the number in the Input Box, it could just look at all the *.ped files in that folder and process them all, one after the other?
The other thing I would like to do, if possible, is replace the ASAP Utilities codes with VBA coding. When the ASAP Utilities codes start to run, they turn off the screen updating command and you see everything that’s happening. It also slows the macro down.
<o:p></o:p>
The ASAP Utilities codes I’m using are
81 Convert Text to Upper Case
87 Delete Leading, Trailing and Excessive spaces
25 Insert Sheets name in Selected cell
34 Delete Print Area on selected sheet
84 Start each word with Upper Case
40 Remove Unused Empty Rows/Columns
122 Empty Headers & Footers
<o:p></o:p>
Thanks for looking and thanks in advance for any help you can give me.
<o:p></o:p>
Here’s my code
HTML: 
Sub BomFormat()
'
' BomFormat Macro  (NEW BOM MACRO_47.xls/Module1)
' For converting raw text BOM(s)downloaded from SAP into basic
' China Inspection Report format
' Revised 22/04/2005 by P Daubeney to cater for BOMs exported after the SAP 4.7 upgrade
'
On Error Resume Next
'INITIAL CHECK
    Response = MsgBox(".............do you want to import BOM data?", vbYesNo)
 Do Until Response = vbNo
 'SELECT RAW FILE
    Dim Message, Title, Default, MyValue
    Message = "Please Enter Path\File Name for Source File"
    Title = "Create CHINA INSPECTION REPORT(s)" ' Set Title.
    Default = "" ' Set Default.
    ' Display message, title,  and default.
    MyValue = "H:\SAP Imports\" & InputBox(Message, Title, Default) & ".ped"
 'FORMAT RAW FILE TO EXCEL
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = True
   Application.StatusBar = "Now Processing.....     Please Wait"
   
   Workbooks.OpenText Filename:=MyValue, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, _
        9), Array(1, 2), Array(12, 2), Array(17, 2), Array(62, 1), Array(72, 2), Array(75, 2), Array _
        (80, 9))
    Columns("A:F").EntireColumn.Select
    ActiveCell.Columns("A:F").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Copy
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Range("A1:A6").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.Offset(6, 0).Range("A1:A2000").Select
    Selection.Cut Destination:=ActiveCell.Offset(-1, 0).Range("A1:A2000")
    ActiveCell.Offset(-5, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(B2,D2)"
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],RC[1])"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:A2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ActiveCell.Offset(0, -1).Range("A1:A2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1:A2").Select
    Selection.Copy
    ActiveCell.Offset(-1, 1).Range("A1:A2").Select
    ActiveSheet.Paste
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(1, 0).Rows("1:2").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(1, 0).Rows("1:2").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="="
    ActiveCell.Offset(3, 0).Rows("1:2000").EntireRow.Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=1
    ActiveCell.Offset(0, 4).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(2, -1).Range("A1:A2000").Select
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(19, 2), Array(21, 9))
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    ActiveWindow.SmallScroll ToRight:=1
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 1
    ActiveCell.Offset(0, -2).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Replaced by Part No."
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Qty"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Unit"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "REPAIR KIT"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "RE-USE"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "RE-WORK"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "SCRAP"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "MISSING"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "QTY REQD"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "COMMENTS"
    ActiveCell.Offset(0, -10).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Rev"
    ActiveCell.Rows("1:1").EntireRow.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.Offset(0, 5).Columns("A:A").EntireColumn.ColumnWidth = 22.14
    ActiveCell.Offset(-1, 5).Range("A1").Select
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.ColumnWidth = 5
    ActiveWindow.SmallScroll ToRight:=5
    ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.ColumnWidth = 3.86
    ActiveCell.Offset(0, 9).Columns("A:A").EntireColumn.ColumnWidth = 26.71
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.EntireRow.AutoFit
    ActiveWindow.SmallScroll ToRight:=-5
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Font.Bold = True
    ActiveCell.Range("A1:O2000").Select
    ActiveCell.Offset(0, 14).Range("A1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.Offset(1, -14).Range("A1:O1").Select
    ActiveCell.Offset(1, 0).Range("A1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1:O2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "RETURN"
    Range("G1").Select
    ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:=" ", SubAddress:="'Sales Order'!A1"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection.Interior
        .ColorIndex = 8
        .Pattern = xlSolid
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 5
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
         ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$5"
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .Zoom = 60
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.4)
        .BottomMargin = Application.InchesToPoints(0.3)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .CenterHeader = "M/CXXXX INSPECTION AND REBUILD BOMS"
        .RightHeader = "&[Page]/&[Pages]"
        .LeftFooter = "&[File]"
        .CenterFooter = "PAGE &[Page] OF &[Pages]"
        .RightFooter = "PRINTED &[Date]"
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        ActiveWindow.View = xlPageBreakPreview
        ActiveWindow.Zoom = 60
        Range("A1:O1").Select
        'xxxxxxxxxxxxxxxxx
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Rows("6:6").Select
    Selection.Copy
    Rows("1:1").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Rows("7:7").Select
    Selection.Copy
    Rows("2:3").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    End With
   ActiveWindow.View = xlNormalView
    Selection.AutoFilter
    Range("D4").Select
    Selection.Copy
    Range("C2").Select
    ActiveSheet.Paste
    Range("C4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D2").Select
    ActiveSheet.Paste
    Range("G4").Select
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("G2")
    Range("G2:H2").Select
    Range("H2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Merge
    Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    Range("A6").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Columns("G:H").Select
    Range("H1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
    End With
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Columns("A:B").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("C1:D2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A4:O4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Delete Shift:=xlToLeft
     Columns("A:A").ColumnWidth = 6
    Columns("B:B").ColumnWidth = 6
    Columns("C:C").ColumnWidth = 45
    Columns("D:D").ColumnWidth = 17
    Columns("E:E").ColumnWidth = 3.71
    Columns("F:F").ColumnWidth = 17
    Columns("G:G").ColumnWidth = 7.5
    Columns("H:H").ColumnWidth = 5
    Columns("I:I").ColumnWidth = 6.29
    Columns("J:J").ColumnWidth = 6.5
    Columns("K:K").ColumnWidth = 5
    Columns("L:L").ColumnWidth = 6
    Columns("M:M").ColumnWidth = 7
    Columns("N:N").ColumnWidth = 8.5
    Columns("O:O").ColumnWidth = 30
    Rows("4:4").RowHeight = 26.5
    Columns("G:G").Select
    Selection.Replace what:="000", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace what:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Columns("G:G").Select
    Selection.NumberFormat = "@"
    Range("A1").Select
     With Selection
    Columns("A:A").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=".1"
    Selection.Font.Bold = True
    Selection.AutoFilter Field:=1, Criteria1:="..2"
    Selection.Font.ColorIndex = 3
    Selection.AutoFilter Field:=1, Criteria1:="...3"
    Selection.Font.ColorIndex = 5
    Selection.AutoFilter Field:=1, Criteria1:="....4"
    Selection.Font.ColorIndex = 4
    Selection.AutoFilter Field:=1, Criteria1:=".....5"
    Selection.Font.ColorIndex = 8
    Selection.AutoFilter Field:=1, Criteria1:="......6"
    Selection.Font.ColorIndex = 7
    Selection.AutoFilter
    End With
    Range("A4:O4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "Qty Reqd"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("A5").Select
    ActiveWindow.FreezePanes = False
    ActiveWindow.FreezePanes = True
    Columns("G:G").Select
    Selection.Replace what:="000", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace what:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Columns("G:G").Select
    Selection.NumberFormat = "@"
    Range("A1").Select
    Columns("C:C").Select
    Selection.Replace what:=",", Replacement:=", ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Columns("C:E").Select
    
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [81]
    Columns("C:E").Select
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [87]
    Range("D2").Select
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [25]
    Range("4:4").Select
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [34]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [84]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [40]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [122]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [40]
    
    Call Delete_Last_Bordered_Row
MyValue = Left$(MyValue, InStrRev(MyValue, "\"))
ActiveWorkbook.SaveAs Filename:=MyValue & Range("D2") & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWorkbook.Close
   End With
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = False
    Response = MsgBox("....... do you want to process the next file?", vbYesNo)
  Loop
End Sub
    
Sub Delete_Last_Bordered_Row()

Dim Rng As Range, Dn As Range, Temp As String, sht As Worksheet
Dim col
Application.ScreenUpdating = False
For Each sht In ActiveWorkbook.Worksheets
Set Rng = sht.Range("C1:C1000")
    For Each Dn In Rng
        If Dn.Borders(xlEdgeBottom).LineStyle = xlContinuous Then
                Temp = Dn.Address
        End If
Next Dn
    If Temp <> "" Then
    If sht.Range(Temp) = "" Then
        sht.Range(Temp).EntireRow.Delete Shift:=xlUp
    End If
    End If
Next sht
Application.ScreenUpdating = True
End Sub

Regards

Paul
 

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
The Dir function iterates over files in a folder, like this:
Code: 
Option Explicit

Public Sub All_Files_in_Folder()

    Dim folder As String
    Dim filename As String
    
    folder = "H:\SAP Imports\"
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    filename = Dir(folder & "*.ped", vbNormal)
    Do Until filename = ""
        MsgBox folder & filename
        filename = Dir()  ' Get next matching file
    Loop
        
End Sub
For some of the Asap utilities you can use VBA functions like UCase, Trim, Left etc.
 
Upvote 0
Paul

What John has posted should help with cycling through the workbooks.

But I think the main thing you should try is cleaning up the code, and that is actually relevant to going through all the workbooks.

All that use of Select/Selection/ActiveCell isn't needed and actually makes the code hard to follow.

And when combined with Offset, Range("A1") and deleting/inserting it's hard to tell what cell/range you want to deal with.

Here's a small example.
Code: 
' this
 
Columns("A:F").EntireColumn.Select
    ActiveCell.Columns("A:F").EntireColumn.EntireColumn.AutoFit
 
' can be replaced with this
 
Columns("A:F").EntireColumn.AutoFit
Note I've not really looked at the following code because it's just confusing.:eek:

And replacing the ASAP utilities would probably be easy if we knew what they did.:)
 
Upvote 0
i Guys,

Thanks for the answers.

John,
I've put this code into the module, but I don't know how to integrate with my existing code.

Norie,
The code was written a long time ago,not by me because I'm not that good with VBA, and I'm trying to modify it to do what I want it to do. Most of my mods have been done by using the macro recorder and sticking the code on the end of the existing code, so I realise it's untidy, but I don't understand enough of VBA to modify it.

Thanks for your help.

Regards
Paul
 
Upvote 0
I would integrate the 2 routines by changing BomFormat() to accept a string parameter called MyValue (because that's the variable it uses as the .ped filename to open) and remove the prompts and looping code. Now you can call BomFormat() from All_Files_in_Folder() with the each .ped file, like this (untested):
Code: 
Option Explicit

Public Sub All_Files_in_Folder()

    Dim folder As String
    Dim filename As String
    
    folder = "H:\SAP Imports\"
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    filename = Dir(folder & "*.ped", vbNormal)
    Do Until filename = ""
        BomFormat (folder & filename)
        filename = Dir()  ' Get next matching file
    Loop
        
End Sub


Sub BomFormat(MyValue As String)
'
' BomFormat Macro  (NEW BOM MACRO_47.xls/Module1)
' For converting raw text BOM(s)downloaded from SAP into basic
' China Inspection Report format
' Revised 22/04/2005 by P Daubeney to cater for BOMs exported after the SAP 4.7 upgrade
'
On Error Resume Next
'INITIAL CHECK
 '   Dim Message, Title, Default, MyValue
 
 'FORMAT RAW FILE TO EXCEL
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = True
   Application.StatusBar = "Now Processing.....     Please Wait"
   
   Workbooks.OpenText filename:=MyValue, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, _
        9), Array(1, 2), Array(12, 2), Array(17, 2), Array(62, 1), Array(72, 2), Array(75, 2), Array _
        (80, 9))
    Columns("A:F").EntireColumn.Select
    ActiveCell.Columns("A:F").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Copy
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Range("A1:A6").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.Offset(6, 0).Range("A1:A2000").Select
    Selection.Cut Destination:=ActiveCell.Offset(-1, 0).Range("A1:A2000")
    ActiveCell.Offset(-5, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(B2,D2)"
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],RC[1])"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:A2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ActiveCell.Offset(0, -1).Range("A1:A2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1:A2").Select
    Selection.Copy
    ActiveCell.Offset(-1, 1).Range("A1:A2").Select
    ActiveSheet.Paste
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(1, 0).Rows("1:2").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(1, 0).Rows("1:2").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="="
    ActiveCell.Offset(3, 0).Rows("1:2000").EntireRow.Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=1
    ActiveCell.Offset(0, 4).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(2, -1).Range("A1:A2000").Select
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(19, 2), Array(21, 9))
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    ActiveWindow.SmallScroll ToRight:=1
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 1
    ActiveCell.Offset(0, -2).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Replaced by Part No."
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Qty"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Unit"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "REPAIR KIT"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "RE-USE"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "RE-WORK"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "SCRAP"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "MISSING"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "QTY REQD"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "COMMENTS"
    ActiveCell.Offset(0, -10).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Rev"
    ActiveCell.Rows("1:1").EntireRow.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.Offset(0, 5).Columns("A:A").EntireColumn.ColumnWidth = 22.14
    ActiveCell.Offset(-1, 5).Range("A1").Select
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.ColumnWidth = 5
    ActiveWindow.SmallScroll ToRight:=5
    ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.ColumnWidth = 3.86
    ActiveCell.Offset(0, 9).Columns("A:A").EntireColumn.ColumnWidth = 26.71
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.EntireRow.AutoFit
    ActiveWindow.SmallScroll ToRight:=-5
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Font.Bold = True
    ActiveCell.Range("A1:O2000").Select
    ActiveCell.Offset(0, 14).Range("A1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.Offset(1, -14).Range("A1:O1").Select
    ActiveCell.Offset(1, 0).Range("A1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1:O2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "RETURN"
    Range("G1").Select
    ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:=" ", SubAddress:="'Sales Order'!A1"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection.Interior
        .ColorIndex = 8
        .Pattern = xlSolid
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 5
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
         ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$5"
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .Zoom = 60
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.4)
        .BottomMargin = Application.InchesToPoints(0.3)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .CenterHeader = "M/CXXXX INSPECTION AND REBUILD BOMS"
        .RightHeader = "&[Page]/&[Pages]"
        .LeftFooter = "&[File]"
        .CenterFooter = "PAGE &[Page] OF &[Pages]"
        .RightFooter = "PRINTED &[Date]"
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        ActiveWindow.View = xlPageBreakPreview
        ActiveWindow.Zoom = 60
        Range("A1:O1").Select
        'xxxxxxxxxxxxxxxxx
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Rows("6:6").Select
    Selection.Copy
    Rows("1:1").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Rows("7:7").Select
    Selection.Copy
    Rows("2:3").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    End With
   ActiveWindow.View = xlNormalView
    Selection.AutoFilter
    Range("D4").Select
    Selection.Copy
    Range("C2").Select
    ActiveSheet.Paste
    Range("C4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D2").Select
    ActiveSheet.Paste
    Range("G4").Select
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("G2")
    Range("G2:H2").Select
    Range("H2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Merge
    Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    Range("A6").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Columns("G:H").Select
    Range("H1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
    End With
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Columns("A:B").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("C1:D2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A4:O4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Delete Shift:=xlToLeft
     Columns("A:A").ColumnWidth = 6
    Columns("B:B").ColumnWidth = 6
    Columns("C:C").ColumnWidth = 45
    Columns("D:D").ColumnWidth = 17
    Columns("E:E").ColumnWidth = 3.71
    Columns("F:F").ColumnWidth = 17
    Columns("G:G").ColumnWidth = 7.5
    Columns("H:H").ColumnWidth = 5
    Columns("I:I").ColumnWidth = 6.29
    Columns("J:J").ColumnWidth = 6.5
    Columns("K:K").ColumnWidth = 5
    Columns("L:L").ColumnWidth = 6
    Columns("M:M").ColumnWidth = 7
    Columns("N:N").ColumnWidth = 8.5
    Columns("O:O").ColumnWidth = 30
    Rows("4:4").RowHeight = 26.5
    Columns("G:G").Select
    Selection.Replace what:="000", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace what:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Columns("G:G").Select
    Selection.NumberFormat = "@"
    Range("A1").Select
     With Selection
    Columns("A:A").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=".1"
    Selection.Font.Bold = True
    Selection.AutoFilter Field:=1, Criteria1:="..2"
    Selection.Font.ColorIndex = 3
    Selection.AutoFilter Field:=1, Criteria1:="...3"
    Selection.Font.ColorIndex = 5
    Selection.AutoFilter Field:=1, Criteria1:="....4"
    Selection.Font.ColorIndex = 4
    Selection.AutoFilter Field:=1, Criteria1:=".....5"
    Selection.Font.ColorIndex = 8
    Selection.AutoFilter Field:=1, Criteria1:="......6"
    Selection.Font.ColorIndex = 7
    Selection.AutoFilter
    End With
    Range("A4:O4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "Qty Reqd"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("A5").Select
    ActiveWindow.FreezePanes = False
    ActiveWindow.FreezePanes = True
    Columns("G:G").Select
    Selection.Replace what:="000", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace what:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Columns("G:G").Select
    Selection.NumberFormat = "@"
    Range("A1").Select
    Columns("C:C").Select
    Selection.Replace what:=",", Replacement:=", ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Columns("C:E").Select
    
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [81]
    Columns("C:E").Select
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [87]
    Range("D2").Select
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [25]
    Range("4:4").Select
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [34]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [84]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [40]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [122]
    Application.Run "'ASAP Utilities.xla'!ASAPRunProc", [40]
    
    Call Delete_Last_Bordered_Row
MyValue = Left$(MyValue, InStrRev(MyValue, "\"))
ActiveWorkbook.SaveAs filename:=MyValue & Range("D2") & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWorkbook.Close
   End With
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = False
End Sub
    
Sub Delete_Last_Bordered_Row()

Dim Rng As Range, Dn As Range, Temp As String, sht As Worksheet
Dim col
Application.ScreenUpdating = False
For Each sht In ActiveWorkbook.Worksheets
Set Rng = sht.Range("C1:C1000")
    For Each Dn In Rng
        If Dn.Borders(xlEdgeBottom).LineStyle = xlContinuous Then
                Temp = Dn.Address
        End If
Next Dn
    If Temp <> "" Then
    If sht.Range(Temp) = "" Then
        sht.Range(Temp).EntireRow.Delete Shift:=xlUp
    End If
    End If
Next sht
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Paul

I'm not saying just change it as if by magic - do it bit by bit.

The first thing I would do is find out what the code is actually meant to do, that should make it easier to tidy it up.

I'll have another look at it and see if I can make some suggestions, but the way it's been written makes it very confusing to follow.

The main problem is trying to work out what is actually being selected etc.

This can replace the code just before the ASAP stuff.
Code: 
    With Columns("G:G")
            .Replace what:="000", Replacement:=" ", LookAt:=xlPart, _
                         SearchOrder:=xlByRows, MatchCase:=False
            .Replace what:=",", Replacement:=".", LookAt:=xlPart, _
                         SearchOrder:=xlByRows, MatchCase:=False
            .NumberFormat = "@"
    End With
 
 
    Columns("C:C").Replace what:=",", Replacement:=", ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

And this can replace the Borders stuff.
Code: 
    With Range("A4:O4")
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    End With
    
    With Range("N4")
        .Value = "Qty Reqd"
        .Font.Bold = True
    End With
 
Last edited:
Upvote 0
Hi John,
This gives me an error and says 'Wrong number of arguments or invalid property' and highlights the BomFormat in the Option Explicit.

Regards
Paul
 
Upvote 0
Hi John,

I've played about with a bit and it's running perfectly now.

Thanks for your help.
Regards
Paul
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
73
Micron
M
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
331
RoryA
RoryA
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
187
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
861
kerm007
K
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
491
kevin9999
K

Forum statistics

Threads
1,214,954
Messages
6,122,461
Members
449,085
Latest member
ExcelError

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