My code Pauses - please help

[whytrigg]

I've written what I considered to be a fancy bit of code to classify "work orders" into two categories, but when there is a lot of data, it's no so fancy.

The code acts strangely as it simply appears to pause on this line:

"data.Range(workorders_S & ":" & workorders_S).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=filter, CopytoRange:=WOs.Range("A1"), unique:=True"

To summarize, the macro uses an advanced filter to pull unique work orders into a list which it then cycles through. Another Advanced filter is created using the current work order number and if the macro finds a specific job number (many jobs in a work order) it classifies all of the jobs in the entire work order as PM and if not, it classifies it all as repair.

It works fine most of the time, but when there is a huge amount of data if simply stops on that line, when I try step past it in debug mode, it doesn't move.I have to drag it to the next line then carry on.

Can anyone see why it would do this?

Thanks

Sub pmRepair()


Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.DisplayAlerts = False
Application.DisplayAlerts = True


Set toolsWB = ThisWorkbook


PMFile = Application.GetOpenFilename
If PMFile = "False" Then




    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox ("No file selected, can not continue")
    End


End If


Application.StatusBar = "Initializing macro"


Set wb = Workbooks.Open(PMFile)


On Error GoTo Err1:
Set data = wb.Worksheets("Data")
On Error GoTo 0


Application.StatusBar = "Adding Temporary Worksheets"
Set ws = wb.Worksheets.Add
ws.name = "Temp"


Set WOs = wb.Worksheets.Add
WOs.name = "WorkOrders"


Set FilterWS = wb.Worksheets.Add
FilterWS.name = "AdFilt"
FilterWS.Range("A1").Value = "Work Order"
Set filter = FilterWS.Range("A1:A2")


Application.StatusBar = "Searching Data for Job Codes"
'search for column with job codes in


JobCol = GetColumnNumber("Job Code")
If JobCol = 0 Then
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox ("Job Code Column needs to be titled Job Code before this macro can continue, please update, save close and start again")
    End
End If
JobCol_S = ConvertToLetter(JobCol)


Application.StatusBar = "Searching Data for Work Orders"
'Find work order column
workorders = GetColumnNumber("Work Order")


If workorders = 0 Then
    workorders = GetColumnNumber("Work Orders")
        If workorders = 0 Then
            workorders = GetColumnNumber("WO")
            If workorders = 0 Then
                workorders = GetColumnNumber("WOs")
                If workorders = 0 Then
                    workorders = GetColumnNumber("Work Order #")
                    If workorders = 0 Then
                        Application.EnableEvents = True
                        Application.ScreenUpdating = True
                        MsgBox ("Please ensure the Work Orders Column is named Work Order, save and close and start again")
                        ws.Delete
                        WOs.Delete
                        FilterWS.Delete
                        End
                    End If
                End If
            End If
        End If
End If
workorders_S = ConvertToLetter(workorders)


Application.StatusBar = "Checking Filter"
'Ensure work order filter is correct
If data.Range(workorders_S & "1").Value <> FilterWS.Range("A1").Value Then
FilterWS.Range("A1").Value = data.Range(workorders_S & "1").Value


    Application.EnableEvents = True
    Application.ScreenUpdating = True
    If MsgBox("Work Orders column was not as expected, is the column with work orders titled " & data.Range(workorders_S & "1").Value & " ?", vbYesNo) = vbNo Then
    
        MsgBox ("Please rename the work orders column to Work Order and ensure no other columns start with that name")
        Application.DisplayAlerts = False
        FilterWS.Delete
        WOs.Delete
        ws.Delete
        Application.DisplayAlerts = True
        End
    
    End If
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End If


Application.StatusBar = "Add Results Column"
'Find Last Column
LastCol = data.Cells(1, Columns.Count).End(xlToLeft).Column


'Load Result Column
If GetColumnNumber("PM / Repair") = 0 Then
data.Cells(1, LastCol + 1).Value = "PM / Repair"
LastCol = LastCol + 1
LastCol_S = ConvertToLetter(LastCol)
ResultCol = LastCol
ResultCol_S = LastCol_S
Else
GetColumnNumber ("PM / Repair")
End If


Application.StatusBar = "Add References"
'Load Reference column
data.Cells(1, LastCol + 1).Value = "Reference"
LastCol = LastCol + 1
LastCol_S = ConvertToLetter(LastCol)
RefCol = LastCol
RefCol_S = LastCol_S




data.Cells(2, LastCol).Value = 2
data.Cells(3, LastCol).Value = 3




data.Range(LastCol_S & "2:" & LastCol_S & "3").AutoFill data.Range(LastCol_S & "2:" & LastCol_S & data.Cells(data.Cells.Rows.Count, "A").End(xlUp).Row)


Application.StatusBar = "Identify Work Orders to Process"
'copy WO's to WO tab


:crash:data.Range(workorders_S & ":" & workorders_S).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=filter, CopytoRange:=WOs.Range("A1"), unique:=True:crash:






    For i = 2 To WOs.Cells(WOs.Rows.Count, 1).End(xlUp).Row
    
    FilterWS.Range("A2").Value = WOs.Range("A" & i)


    data.Range("A1:" & LastCol_S & data.Cells(data.Cells.Rows.Count, "A").End(xlUp).Row).AdvancedFilter xlFilterCopy, filter, ws.Range("A1")
    
        For i2 = 2 To ws.Cells(ws.Cells.Rows.Count, 1).End(xlUp).Row


            If ws.Range(JobCol_S & i2).Value = "06-24-AHI" Or ws.Range(JobCol_S & i2).Value = "06-24-ANN" Or ws.Range(JobCol_S & i2).Value = "06-24-AVI" Or ws.Range(JobCol_S & i2).Value = "06-24-BIW" Or ws.Range(JobCol_S & i2).Value = "06-24-CVI" Or ws.Range(JobCol_S & i2).Value = "06-24-MAJ" Or ws.Range(JobCol_S & i2).Value = "06-24-MIN" Or ws.Range(JobCol_S & i2).Value = "06-24-SIX" Or ws.Range(JobCol_S & i2).Value = "06-36-MAJ" Then
            
                For i3 = 2 To ws.Cells(ws.Cells.Rows.Count, 1).End(xlUp).Row
            
                    data.Range(ResultCol_S & ws.Range(RefCol_S & i3).Value) = "PM"


                Next i3
                GoTo jumpi
            
            Else
            'do nothing
            
                data.Range(ResultCol_S & ws.Range(RefCol_S & i2).Value) = "Repair"
            
            End If






        
    'data.ShowAllData


    Next i2
jumpi:
    ws.UsedRange.Clear
    DoEvents
    Application.StatusBar = "Executing " & i & " of " & WOs.Cells(WOs.Rows.Count, 1).End(xlUp).Row & " Work orders"
    Next i




Application.DisplayAlerts = False


FilterWS.Delete
WOs.Delete
ws.Delete


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = False
Application.DisplayAlerts = True


data.Cells(1, RefCol).EntireColumn.Delete


wb.Save
MsgBox ("Process completed")
End


Err1:
Set data = wb.Worksheets(1)
Resume Next


End Sub


Sub Progresscode()


'code to follow in later version


End Sub


Private Function GetColumnNumber(name As String) As Long
    Dim play As Variant, j As Long, Current As Long
    Set play = data.Range("1:1")
    For i = 1 To data.Cells(1, Columns.Count).End(xlToLeft).Column
        If InStr(play(1, i), name) > 0 Then
            Current = i
        End If
    Next i
    GetColumnNumber = Current


End Function


Function ConvertToLetter(iCol As Long) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function