Run time error (I believe) is causing Excel to crash

kingconsto

New Member
Joined
Apr 19, 2017
Messages
31
Hi All,

I have what I believe to be a basic marco which usually runs fine but at times the code seems to get stuck in a loop and I have to force excel to close. Is the code in a bad format? How can I fix this issue? I believe it might have something to do with the loop or "On Error Resume Next" Appreciate the help!

Code:
Sub TREATS()
'
' TREATS Macro
'
Dim s, so, macname As String
Dim marker As Integer
Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Sheets("Data").Select
    Range("AK9:EQ33").Select
    'Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Treats").Select
    Range("A3").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Treats").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Treats").Sort.SortFields.Add Key:=Range("A3"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Treats").Sort
        .SetRange Range("A3:DG17")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Treats").Select
    Range("A3").Select
    
      StaffID = InputBox("Please enter staff ID")
macname = "C:\Users" & StaffID & "\AppData\Roaming\IBM\Personal Communications\benelux.mac"
Set so = CreateObject("Scripting.FileSystemObject")
    so.CreateTextFile macname
Set s = so.OpenTextFile(macname, ForWriting)
    s.writeline "Description ="
marker = 3
Do While Cells(marker, 1) <> "N"
    s.writeline Cells(marker, 2).Value
    s.writeline Cells(marker, 3).Value
    s.writeline Cells(marker, 4).Value
    s.writeline Cells(marker, 5).Value
    s.writeline Cells(marker, 6).Value
    s.writeline Cells(marker, 7).Value
    s.writeline Cells(marker, 8).Value
    s.writeline Cells(marker, 9).Value
    s.writeline Cells(marker, 10).Value
    s.writeline Cells(marker, 11).Value
    s.writeline Cells(marker, 12).Value
    s.writeline Cells(marker, 13).Value
    s.writeline Cells(marker, 14).Value
    s.writeline Cells(marker, 15).Value
    s.writeline Cells(marker, 16).Value
    s.writeline Cells(marker, 17).Value
    s.writeline Cells(marker, 18).Value
    s.writeline Cells(marker, 19).Value
    s.writeline Cells(marker, 20).Value
    s.writeline Cells(marker, 21).Value
    s.writeline Cells(marker, 22).Value
    s.writeline Cells(marker, 23).Value
    s.writeline Cells(marker, 24).Value
    s.writeline Cells(marker, 25).Value
    s.writeline Cells(marker, 26).Value
    s.writeline Cells(marker, 27).Value
    s.writeline Cells(marker, 28).Value
    s.writeline Cells(marker, 29).Value
    s.writeline Cells(marker, 30).Value
    s.writeline Cells(marker, 31).Value
    s.writeline Cells(marker, 32).Value
    s.writeline Cells(marker, 33).Value
    s.writeline Cells(marker, 34).Value
    s.writeline Cells(marker, 35).Value
    s.writeline Cells(marker, 36).Value
    s.writeline Cells(marker, 37).Value
    s.writeline Cells(marker, 38).Value
    s.writeline Cells(marker, 39).Value
    s.writeline Cells(marker, 40).Value
    s.writeline Cells(marker, 41).Value
    s.writeline Cells(marker, 42).Value
    s.writeline Cells(marker, 43).Value
    s.writeline Cells(marker, 44).Value
    s.writeline Cells(marker, 45).Value
    s.writeline Cells(marker, 46).Value
    s.writeline Cells(marker, 47).Value
    s.writeline Cells(marker, 48).Value
    s.writeline Cells(marker, 49).Value
    s.writeline Cells(marker, 50).Value
    s.writeline Cells(marker, 51).Value
    s.writeline Cells(marker, 52).Value
    s.writeline Cells(marker, 53).Value
    s.writeline Cells(marker, 54).Value
    s.writeline Cells(marker, 55).Value
    s.writeline Cells(marker, 56).Value
    s.writeline Cells(marker, 57).Value
    s.writeline Cells(marker, 58).Value
    s.writeline Cells(marker, 59).Value
    s.writeline Cells(marker, 60).Value
    s.writeline Cells(marker, 61).Value
    s.writeline Cells(marker, 62).Value
    s.writeline Cells(marker, 63).Value
    s.writeline Cells(marker, 64).Value
    s.writeline Cells(marker, 65).Value
    s.writeline Cells(marker, 66).Value
    s.writeline Cells(marker, 67).Value
    s.writeline Cells(marker, 68).Value
    s.writeline Cells(marker, 69).Value
    s.writeline Cells(marker, 70).Value
    s.writeline Cells(marker, 71).Value
    s.writeline Cells(marker, 72).Value
    s.writeline Cells(marker, 73).Value
    s.writeline Cells(marker, 74).Value
    s.writeline Cells(marker, 75).Value
    s.writeline Cells(marker, 76).Value
    s.writeline Cells(marker, 77).Value
    s.writeline Cells(marker, 78).Value
    s.writeline Cells(marker, 79).Value
    s.writeline Cells(marker, 80).Value
    s.writeline Cells(marker, 81).Value
    s.writeline Cells(marker, 82).Value
    s.writeline Cells(marker, 83).Value
    s.writeline Cells(marker, 84).Value
    s.writeline Cells(marker, 85).Value
    s.writeline Cells(marker, 86).Value
    s.writeline Cells(marker, 87).Value
    s.writeline Cells(marker, 88).Value
    s.writeline Cells(marker, 89).Value
    s.writeline Cells(marker, 90).Value
    s.writeline Cells(marker, 91).Value
    s.writeline Cells(marker, 92).Value
    s.writeline Cells(marker, 93).Value
    s.writeline Cells(marker, 94).Value
    s.writeline Cells(marker, 95).Value
    s.writeline Cells(marker, 96).Value
    s.writeline Cells(marker, 97).Value
    s.writeline Cells(marker, 98).Value
    s.writeline Cells(marker, 99).Value
    s.writeline Cells(marker, 100).Value
    s.writeline Cells(marker, 101).Value
    s.writeline Cells(marker, 102).Value
    s.writeline Cells(marker, 103).Value
    s.writeline Cells(marker, 104).Value
    s.writeline Cells(marker, 105).Value
    s.writeline Cells(marker, 106).Value
    s.writeline Cells(marker, 107).Value
    s.writeline Cells(marker, 108).Value
    s.writeline Cells(marker, 109).Value
    s.writeline Cells(marker, 110).Value
    s.writeline Cells(marker, 111).Value
    marker = marker + 1
    On Error Resume Next
Loop
MsgBox ("BENELUX MACRO CREATED")
End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,686
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Do you ever have a situation where column A might not have an N in it? Note: for this code, 'n' is not the same as 'N'. It would be safer to limit the Do Loop so that it can't go past the last row that might have data.

I'm also unclear as to why you copy 25 rows but then only sort 15?
 
Last edited:

kingconsto

New Member
Joined
Apr 19, 2017
Messages
31
I have changed the sort to include all 25 rows.

Non of the data being copied in column A has an "N" in it except one. It looks like this:

[pf1]
[pf1]
[pf1]
[pf1]
[pf1]
[pf1]
[pf1]
[pf1]
N
[pf1]
[pf1]
[pf1]
[pf1]
[pf1]
[pf1]

<tbody>
</tbody>














<tbody>
</tbody>
 
Last edited:

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,476
Cannot see anything immediately wrong with the code, but try the following (untested) and if it errors, reply with the error message and what line is highlighted yellow:
Code:
Sub Treats_v1()

    Dim arr()   As Variant
    Dim strFile As Variant
    Dim str     As String
    Dim x       As Long
    Dim y       As Long
    
    str = InputBox("Please enter staff ID:")
    str = Replace("C:\Users@1\AppData\Roaming\IBM\Personal Communications\benelux.mac", "@1", str)
    
    Application.ScreenUpdating = False

    arr = Sheets("Data").Range("AK9:EQ33").Value
    
    With Sheets("Treats")
        .Range("A3").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        With .Sort
            .SortFields.Clear
            .SortFields.add key:=.Range("A3"), SortOn:=xlSortOnValues, Order:=xlAscending
            .SetRange .Range("A3:DG17")
            .header = xlNo
            .MatchCase = False
            .Orientation = XlTopBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        x = .Cells(.Rows.Count, 1).End(xlUp).row

        On Error Resume Next
        x = .Cells(1, 1).Resize(x).find(what:="N", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True).row
        On Error Goto 0
        If .Cells(x, 1).Value <> "N" Then
            Erase arr
            Application.ScreenUpdating = True
            MsgBox "Cannot find N value in column A, please check and try again", vbExclamation, "Missing Value"
            Exit Sub
        End If
        Erase arr
        arr = .Cells(3, 1).Resize(x - 2, 111).Value
    End With
           
    With CreateObject("Scripting.FileSystemObject")
        .createtextfile str
        Set strFile = .opentextfile(str, ForWriting)
        strFile.writeline "Description ="
        For x = LBound(arr, 1) To UBound(arr, 1)
            For y = LBound(arr, 2) To UBound(arr, 2)
                s.writeline arr(x, y)
            Next y
        Next x
    End With

    Application.ScreenUpdating = True
   
    MsgBox ("BENELUX MACRO CREATED")
    
    Set strFile = Nothing
    Erase arr
    
End Sub
 
Last edited:

kingconsto

New Member
Joined
Apr 19, 2017
Messages
31
I am getting a Compile error: Expected variable or procedure, not module. It is highlighting XLTopBottom
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,686
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
It should be xlTopToBottom as in your original.
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,476
Perils of not using copy & paste and with untested code, thanks for spot RoryA
 

kingconsto

New Member
Joined
Apr 19, 2017
Messages
31
Ok. got it. The error is Run-time error '438': Object doesn't support this property or method.
.SortFields.Add Key:=.Range("A3"), SortOn:=xlSortOnValues, Order:=xlAscending
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,476
Changed it around, I think I've had a problem with .Sort in a With statement before, probably the .Range("A3") part wasn't a child of the With .Sort. Anyway, try:
Code:
Sub Treats_v1()

    Dim arr()   As Variant
    Dim strFile As Variant
    Dim str     As String
    Dim x       As Long
    Dim y       As Long
    
    str = InputBox("Please enter staff ID:")
    str = Replace("C:\Users@1\AppData\Roaming\IBM\Personal Communications\benelux.mac", "@1", str)
    
    Application.ScreenUpdating = False

    arr = Sheets("Data").Range("AK9:EQ33").Value
    
    With Sheets("Treats")
        .Range("A3").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        .Sort.SortFields.Clear
        .Sort.SortFields.add key:=.Range("A3"), SortOn:=xlSortOnValues, Order:=xlAscending
        x = .Cells(.Rows.Count, 1).End(xlUp).row
        With .Sort
            .SetRange .Range("A3:DG" & x)
            .header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        On Error Resume Next
        x = .Cells(1, 1).Resize(x).find(what:="N", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True).row
        If .Cells(x, 1).Value <> "N" Then
            MsgBox "Cannot find N value in column A, please check and try again", vbExclamation, "Missing Value"
            Exit Sub
        End If
        Erase arr
        arr = .Cells(3, 1).Resize(x - 2, 111).Value
    End With
           
    With CreateObject("Scripting.FileSystemObject")
        .createtextfile str
        Set strFile = .opentextfile(str, ForWriting)
        strFile.writeline "Description ="
        For x = LBound(arr, 1) To UBound(arr, 1)
            For y = LBound(arr, 2) To UBound(arr, 2)
                s.writeline arr(x, y)
            Next y
        Next x
    End With
   
    MsgBox ("BENELUX MACRO CREATED")
    
    Set strFile = Nothing
    Erase arr
    
End Sub
 
Last edited:

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,686
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Still won't work as this line:

Code:
.SetRange .Range("A3:DG" & x)
is linking the range back to the Sort object, not the worksheet. Try:

Code:
.SetRange .Parent.Range("A3:DG" & x)
 

Forum statistics

Threads
1,089,267
Messages
5,407,266
Members
403,131
Latest member
Lewas2019

This Week's Hot Topics

Top