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

K

kingconsto

New Member
Joined
Apr 19, 2017
Messages
32
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:
Sort by date Sort by votes
There seems to be an issue with .SetRange .Range("A3:DG17") I have taken out the dot in front of range. So it now reads .SetRange Range("A3:DG17") . After the change the code compiles just fine.
 
Upvote 0

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
.SetRange .Parent.Range("A3:DG" & x) is giving a run-time error '1004': Application-defined or object defined error.
 
Upvote 0
Thanks RoryA, corrected (for OP benefit), code is:
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
        Erase arr
        x = .Cells(.Rows.Count, 1).End(xlUp).row
        .Sort.SortFields.Clear
        .Sort.SortFields.add key:=.Range("A3"), SortOn:=xlSortOnValues, Order:=xlAscending
        With .Sort
            .SetRange .Parent.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
        On Error GoTo 0

        If .Cells(x, 1).Value <> "N" Then
            MsgBox "Cannot find N value in column A, please check and try again", vbExclamation, "Missing Value"
            Application.ScreenUpdating = True
            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
        Set strFile = Nothing
    End With
   
    Application.ScreenUpdating = True
   
    MsgBox "BENELUX MACRO CREATED", vbOKOnly
            
End Sub
 
Last edited:
Upvote 0
There is only one problem with the solution...the marco does not update when the relevant fields are overwritten. I change the data before each run and the marco wont update with the new data.
 
Upvote 0
Can you be more specific, what relevant field is over-written?
 
Upvote 0
All the fields. The macro should compile data from Sheet "Data" and copy it to sheet "Treats." That information in "Treats" should now be the inputs for benelux.mac and update it accordingly. When I run benelux.mac it should be the same values as what in "Treats" which is the same values as what's in "Data." Currently only the sheets "Data" and "Treats" is being updated.
 
Upvote 0
I believe it has something to with the code below. I do not think that it is overwriting the .mac file as planned.

Code: 
    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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Locked
  • Question Question
Vba code for User history log which is giving me a run-time error "13" mismatch
Replies
2
Views
148
Fluff
Fluff
J
  • Question Question
Using Sheets().Select in a Worksheet_Activate() macro
2
Replies
10
Views
445
jdun
J
M
  • Question Question
Run time error 1004: Application defined or object defined error
Replies
1
Views
521
Micron
M
S
  • Question Question
Macro crashes since update of excel to v.2408.
Replies
2
Views
168
Saab95
S
L
  • Solved
Adding empty lines based on value via “I” loop which crashes and lags
2
Replies
10
Views
389
Joe4
Joe4

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

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