1

Couple of our users in office is getting the error mentioned above while running the Macro. In my research most of the forums were pointing out to possible file corruption.

I tried repairing the Excel file in question "PO_Summary" and tried copying the content to a new file and replacing the old one with the new one and so one. I also tried passing the argument CorruptLoad: xlrepair option also. But now I am getting error:

Run Time Error 9 Script Out of Range.

Here is the script.

Sub reqno()

Dim flname$, srno, newsrno, nsrno$, Leng, I, fname$, user$
Dim str1$, str2$, str3$, str4$, str5$, str6$, str7$, str8$, str9$, str10$, str11$, str12$
Dim r, j, d As Long
'Error Handling
If (ActiveSheet.Range("AH2:AH2") > 0) Then
        str4$ = "   __ ERRORS ________________________________________________"
        str5$ = ActiveSheet.Range("AH3:AH3")  'Error 1
        str6$ = ActiveSheet.Range("AH4:AH4")  'Error 2
        str7$ = ActiveSheet.Range("AH5:AH5")
        str8$ = ActiveSheet.Range("AH6:AH6")
        str9$ = ActiveSheet.Range("AH7:AH7")
        str10$ = ActiveSheet.Range("AH8:AH8")
        str11$ = ActiveSheet.Range("AH9:AH9")
        str12$ = "  __________________________________________________________"

    ConstVbinfotext = 2147483625

    j = MsgBox(" 'Purchase Requisition Form' can not be generated, due to the following errors." & _
        Chr(13) & Chr(13) & str4$ & Chr(13) & Chr(13) & str5$ & Chr(13) & str6$ & Chr(13) & str7$ & Chr(13) & str8$ & _
        Chr(13) & str9$ & Chr(13) & str10$ & Chr(13) & str11$ & Chr(13) & str12$ & Chr(13) & Chr(13) _
        + "                    Regenerate the requisition once fields are duly filled" & Chr(13), _
        vbApplicationModal + vbCancelonly, "I N C O M P L E T E  Requisition Form")

Else
         r = MsgBox("Are you sure you want to Generate Purchase Requisition?", _
         vbQuestion + vbYesNo, "PCDO Purchase Requisition")
        'If ok
    If r = vbYes Then
        flname$ = "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\Counter\reqno.TXT"

        Open flname$ For Input As 1
            While Not EOF(1)
                Input #1, srno
            Wend
        Close 1
        newsrno = srno + 1
        user$ = UCase(Application.UserName)
        Open flname$ For Output As 1
            Write #1, newsrno
        Close 1
            nsrno$ = newsrno


            ActiveSheet.Shapes("Button 42").Select
            Selection.Delete

            ActiveSheet.Shapes("Button 61").Select
            Selection.Delete

        fname$ = UCase("C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\" + nsrno$ + "_" + user$ + ".xls")
        ThisWorkbook.CheckCompatibility = False
        ActiveWorkbook.SaveAs Filename:=fname$, FileFormat:=xlNormal, Password:="Benreqn", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        str1$ = "                           Your Purchase Request Has Been Registered As                         "
        str2$ = "                                                    " & (nsrno$) & "_" & user$ & ".xls                                         "
        ActiveSheet.Range("J2:J2") = nsrno$
        'Update the Summary file
        Sheets("PO").Select
        Sheets("database").Visible = True
        Sheets("database").Select
        UnProtect
            Sheets("database").Select
            Range("A2:X21").Select
            Selection.Copy
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Range("A2").Select
        Dim countnonblank As Integer, myRange As Range
        Set myRange = Columns("A:A")
            countnonblank = Application.WorksheetFunction.Count(myRange)
            Range("A" & countnonblank + 1, "X2").Select
            Selection.Copy
            ActiveWindow.SelectedSheets.Visible = False
            Sheets("PO").Select

            Workbooks.Open Filename:= _
                "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\PO_Smmary.xlsx", CorruptLoad:=xlrepair
            Sheets("Summary").Select
            Range("A1").Select
            NextRow = Range("A65536").End(xlUp).Row + 1
            Range("A" & NextRow).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Range("A1:V25000").Select
            Application.CutCopyMode = False
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A25000") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A1:X25000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
            Range("A1").Select
            ThisWorkbook.CheckCompatibility = False
            ThisWorkbook.Save
            ActiveWorkbook.Save
            ActiveWindow.Close

        Sheets("PO").Select
        Range("J5").Select

    Sheets("PO").Select
    Range("A1:J80").Select

    ExecuteExcel4Macro "PRINT(1,,,1,,TRUE,,,,,,1,,,TRUE,,FALSE)"
        Sheets("PO").Select
        Range("J5").Select
        MsgBox str1$ & Chr(13) & str2$ & Chr(13)
        ThisWorkbook.CheckCompatibility = False
        Sheets("database").Visible = True
        Sheets("database").Select
        Protect
        Sheets("database").Visible = False

        ThisWorkbook.Save
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Else
        MsgBox "Purchase Requisition is not processed", _
            vbInformation + vbOKOnly, "Not Processed"
    End If
    End If

End Sub

Here is the part of the script where I am having trouble with. just copying the part for your reference.

Workbooks.Open Filename:= _
                "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\PO_Smmary.xlsx", _
                CorruptLoad:=xlrepair
            Sheets("Summary").Select
            Range("A1").Select
            NextRow = Range("A65536").End(xlUp).Row + 1
            Range("A" & NextRow).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Range("A1:V25000").Select
            Application.CutCopyMode = False
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A25000") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A1:X25000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
            Range("A1").Select
            ThisWorkbook.CheckCompatibility = False
            ThisWorkbook.Save
            ActiveWorkbook.Save
            ActiveWindow.Close'
Community
  • 1
  • 1
  • This is one of the rare instances where posting the whole code goes nowhere. Can you at kindly point out on which line it's showing the above error? Edit your post and put in a second snippet of the particular line throwing the error. – WGS Oct 20 '14 at 20:13
  • just to add., I was wondering, would it be possible that I am getting this error because the file is open and being used by someone else and the macro is unable to open the workbook "PO_Summary". If yes, can someone tell me how can I change the script to check the status or force open the file or return a error stating that the file is not available for editing. If you know what I mean.. – Jamsheer Meethal Oct 20 '14 at 20:13
  • That could be one reason. Another is the path file of the target workbook is wrong, which is why the opening method fails. – WGS Oct 20 '14 at 20:15
  • I am sure the path is correct. And its strange that when I pass the argument CorruptLoad, I am getting error Run Time Error 9 Script Out of Range. – Jamsheer Meethal Oct 20 '14 at 20:18
  • I am not sure how to add a second snippet. Here is where I am having the error 1004 "Workbooks.Open Filename:= _ "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\PO_Smmary.xlsx" and when CorruptLoad is passed (Which you can see in my original post) I am getting Run Time error 9 in here "ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear" – Jamsheer Meethal Oct 20 '14 at 20:21
  • Check your path. Is that really supposed to be `PO_Smmary.xlsx` and not `PO_Summary.xlsx`? Notice the missing **u**. – WGS Oct 20 '14 at 20:23
  • @JamsheerMeethal did you try `xlRepairFile` ? – ZAT Oct 20 '14 at 20:26
  • `Run Time Error 9 Script Out of Range` You are getting that error probably because it is not able to find a particular sheet. My offhand guess is that you are using lots of `.Select` I would recommend using objects instead of `.Select`. See [THIS](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros/10718179#10718179). Please change your code and try again. – Siddharth Rout Oct 20 '14 at 20:34
  • @Nanashi Yup The file name is PO_Smmary.xlsx, Even at first intance I thought I found the issue :-), but it wasn't. I really appreciate your prompt response, as I am under high pressure from ma manager to fix this. thanks again – Jamsheer Meethal Oct 20 '14 at 20:34
  • Continued from previous comment: Do something like this... `Set wb = Workbooks.open(sPath)` and then `Set Ws = wb.Sheets("Summary")` – Siddharth Rout Oct 20 '14 at 20:36
  • First off, heed @SiddharthRout's advice. The `Select`s are killing the code. Next, consider using `With`. I have this gut feeling that the error with `Sort.SortFields.Clear` is not referencing the workbook you want it to work on, among other potential pitfalls in the code. – WGS Oct 20 '14 at 20:36
  • @ZAT I did try xlRepairFile, but taking me to run time 9, debugging pointing to "ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear" – Jamsheer Meethal Oct 20 '14 at 20:37
  • @JamsheerMeethal try debug.print ActiveWorkbook.name before the sort line to verify workbook name and try to activate or select Sheet1 before running sort. And, try to follow SiddharthRout's and Nanashi's suggestion. – ZAT Oct 20 '14 at 20:53
  • Split your code and add function. Check part if it return result or no. You Can share code and file to check it after. I think you call an object it don't set. Error analyse is dificult because it return top level – GeoStoneMarten Nov 28 '15 at 10:11

0 Answers0