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

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
.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
  • Question
Excel Macro to Save to .pdf not working
Replies
9
Views
216
kpost
K
S
  • Question
"Subscript out of range ( Run time Error: 09)" Problem in My Excel VBA
Replies
5
Views
234
6StringJazzer
6StringJazzer
F
  • Question
VBA run code based off cell value
Replies
1
Views
299
igold
igold
B
  • Solved
Macro crashing and closing excel
Replies
1
Views
200
Beneindias
B
K
  • Question
Scraping a table from a website, VBA code needs to be updated, running into issues
Replies
1
Views
327
Dan_W
D

Forum statistics

Threads
1,214,383
Messages
6,119,198
Members
448,874
Latest member
Lancelots

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