Cant run this macro with run macro only works with steup into

A

agas

New Member
Joined
Mar 22, 2011
Messages
41
When i try to run this macro It jumps to line 146 m skips the whole part at the beggining so it doesnt work. But when i run it from VB editor with f8(stepin) it runs OK.

Any Ideas why it might be like that ?


http://pastebin.com/n5UctSqp
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
Can you please copy/paste your macro code here? Many of the users can't download files, as many workplaces block file downloading.
 
Upvote 0
Code: 
Sub MACRONUNKRALI()
If ActiveWorkbook.Sheets.Count = 1 Then
    Dim wb As Workbook
    For Each wb In Application.Workbooks
    
    wb.Activate
    If ActiveWorkbook.Name = "TK_LO_CAP_REP.xls" Then
    
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 8.17
    Columns("C:C").EntireColumn.AutoFit
    Rows("2:2").Select
    Selection.AutoFilter
    ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=4, Criteria1:="Total"
    Range("A4").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        
    End With
    Range("E4").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=4
    
    Else
     
    If ActiveWorkbook.Name = "5519_capacity_report_short.xls" Then
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("L6").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
'   reordered
    
        Rows("2:2").Select
    Selection.AutoFilter
    
'   Added autofilter
    With ActiveSheet
        .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=15, _
            Criteria1:="00 - Capacity", _
            Operator:=xlFilterValues
        .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Range("$A$2:$AA$17").AutoFilter Field:=15
    End With
'   capacity deleted
    
    With Workbooks("TK_LO_CAP_REP.xls")
    ActiveSheet.Move After:=.Worksheets(.Worksheets.Count)
    End With
    
    
'   moved to TK_LO_CAP_REP
'----------------------------------------------
   Else
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("L6").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
'   reordered
    
        Rows("2:2").Select
    Selection.AutoFilter
    
'   Added autofilter
    With ActiveSheet
        .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=15, _
            Criteria1:="00 - Capacity", _
            Operator:=xlFilterValues
        .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Range("$A$2:$AA$17").AutoFilter Field:=15
    End With
   
'   capacity deleted
    With Workbooks("TK_LO_CAP_REP.xls")
    ActiveSheet.Move After:=.Worksheets(.Worksheets.Count)
    End With
    End If
    End If
    
  Next wb
Else
       
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "TK_LO_CAP_REP" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
     
        'AAP
        
        Dim ws As Worksheet
        Dim LstCol As Integer, y() As Variant
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls"
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                    "AYT", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
                    "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                        
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "AAP_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        'AYT
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls"
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
                "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "AYT_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        'DELTA
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls "
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "AYT", "DHA", "DHQ", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
                "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "DELTA_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        'ETF
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls "
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "AYT", "FAA", "GBB", "IMT", "TIE", "TIP", _
                "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "ETF_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        'GBB
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls "
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "AYT", "IMT", "TIE", "TIP", _
                "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "GBB_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        'IMT
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls "
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "AYT", "TIE", "TIP", _
                "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "IMT_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                
        'TIETIP
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls "
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "AYT", _
                "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "TIETIP_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        'YESIM
        
        ChDir "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\"
        Workbooks.Open Filename:= _
            "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\TK_LO_CAP_REP.xls "
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                .Select
                .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
                "AAP", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
                "AYT", "MAA"), Operator:=xlFilterValues
                .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                .Range("$A$3:$AG$10000").AutoFilter Field:=1
            End With
                
                If ws.Name <> "TK_LO_CAP_REP" And ws.Name <> "5519_capacity_report_short" Then
                    With ws
        '                Sub Subtotal()
                         
                        LstCol = [iv1].End(xlToLeft).Column
                        y = Application.Transpose(Evaluate("row(13:" & LstCol & ")"))
                        Range("a1").End(xlDown).End(xlToRight).Subtotal GroupBy:=5, _
                        Function:=xlSum, TotalList:=y, Replace:=True, _
                        PageBreaks:=False, SummaryBelowData:=True
                        
                        
                     End With
                End If
        Next ws
        
        ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\cap rep\1\" & "Yesim_TK_LO_CAP_REP  (" & Format(Date, "dd-mm-yyyy") & ").xls" _
            , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
        End If
End Sub
 
Upvote 0
How are you calling this macro?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Macro run from Excel to transfer data in new Word doc won't output into Word
Replies
5
Views
389
cpu97
C
C
  • Question Question
Excel for Mac Crashes when I protect Sheet, and run a macro.
Replies
0
Views
281
CKW USMC
C
K
  • Question Question
VBA macro sometimes requires running twice to fully complete
Replies
6
Views
477
knittelmail
K
J
  • Question Question
Macro error
Replies
2
Views
538
Jeeremy7
J
J
  • Question Question
VBA Macros running slow out of nowhere
Replies
4
Views
4K
Tanquen
T

Forum statistics

Threads
1,224,600
Messages
6,179,833
Members
452,947
Latest member
Gerry_F

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