'Subscript out of range' problem when calling a sub from a different sheet

[Blaise]

Dear Experts,

Unfortunately I'm not good at vba coding and I cannot figure out why the last Call in the following code does not work and gives a "Runtime error '9' - Subscript out of range" error.
The macro to be called runs perfectly when started manually.

Here is the main code:

Sub CommandButton1_Click()


    Worksheets("NyersanyagRaktár").Range("G6:G100").Value = Worksheets("NyersanyagBeszerzés").Range("C6:C100").Value
    
    Worksheets("NyersanyagRaktár").Range("B6:B100").Value = Worksheets("NyersanyagRaktár").Range("E6:E100").Value


    Worksheets("NyersanyagRaktár").Range("C6:C100").Value = Worksheets("NyersanyagRaktár").Range("I6:I100").Value
    
    Worksheets("BeszerzésTemp").Range("A6:J100").Value = Worksheets("NyersanyagBeszerzés").Range("A6:J100").Value
    
    Range("C6:E100").Select
    Selection.ClearContents


    Range("H6:I100").Select
    Selection.ClearContents
    
    Worksheets("Nyersanyagraktár").Activate
    Worksheets("Nyersanyagraktár").Range("G6.G100").Select
    Selection.ClearContents
    
   
    Call Sheet17.Purchasedelrowsifzero
    
    Application.CopyObjectsWithCells = False
    ActiveWorkbook.Sheets("BeszerzésTemp").Copy
    
    Call Sheet17.SaveUnique
    
    Call Sheet17.CopyStuff
    
    Call Sheet19.NyersStockSort
    
End Sub

And this is the NyersStockSort macro on Sheet19:

Public Sub NyersStockSort()


    ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort.SortFields.Add Key _
        :=Range("B6:B300"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort.SortFields.Add Key _
        :=Range("J6:J300"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort
        .SetRange Range("B6:J300")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Any help would be highly appreciated.

All the best,
Balazs

 

[RoryA]

If that code works when run manually, it would suggest that the wrong workbook is active when it's being called by the button.

 

[Blaise]

Thank you Rory for the quick reply.

I have only one workbook open. The command button is on Sheet16.

 

[RoryA]

Maybe that's true at the beginning, but this line creates a new workbook:

ActiveWorkbook.Sheets("BeszerzésTemp").Copy

If the code in NyersStockSort should be referring to the workbook with the code in it, use ThisWorkbook rather than ActiveWorkbook.

 

[Blaise]

Maybe that's true at the beginning, but this line creates a new workbook:

ActiveWorkbook.Sheets("BeszerzésTemp").Copy

If the code in NyersStockSort should be referring to the workbook with the code in it, use ThisWorkbook rather than ActiveWorkbook.

The code in NyersStockSort refers to the workbook with the code in it.
I've replaced ActiveWorkbook with ThisWorkbook, but I get the same error at the same line (the last one - Call Sheet19.NyersStockSort).

I'll share the other macros that are called in the main code above, maybe you'll find the problem.

Thank you for taking the time helping me.

Sub Purchasedelrowsifzero()


    Dim rng As Range
    Dim i As Long
    Set rng = Worksheets("BeszerzésTemp").Range("G6:G100")
    With rng
        For i = .Rows.Count To 1 Step -1
            If .Item(i) = "" Then
                .Item(i).EntireRow.Delete
            End If
        Next i
    End With
       
End Sub




Sub SaveUnique()


    ActiveWorkbook.SaveAs Filename:="D:\Documents\ClubDesign\Juiceline\Log\Bevét\Bevét_" & Format(Now(), "yyyymmddhhmm") & ".xls", _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


End Sub


Sub CopyStuff()


Sheet17.Range("B6:J100").Copy


Sheet19.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


End Sub

 

[RoryA]

Can you share the amended code from the NyersStockSort routine? I assume that NyersanyagRaktarTeteles shouldn't actually be NyersanyagraktárTeteles?

Also, which line actually causes the error?

 

[Blaise]

Can you share the amended code from the NyersStockSort routine? I assume that NyersanyagRaktarTeteles shouldn't actually be NyersanyagraktárTeteles?

Also, which line actually causes the error?

This was the code I tried:

Public Sub NyersStockSort()


    ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort.SortFields.Add Key _
        :=Range("B6:B300"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort.SortFields.Add Key _
        :=Range("J6:J300"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("NyersanyagRaktarTeteles").Sort
        .SetRange Range("B6:J300")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

And based on your suggestion I replaced the ActiveWorkbook with ThisWorkbook in this code, and the problem is solved, the main code runs perfectly

Thank you Rory for your help. I couldn't figure this out.

Have a nice weekend

 

[RoryA]

I'm slightly confused as you just said that didn't work, but I'm glad it's fixed now!

 

[Blaise]

Hello,
I didn't want to open a new thread because I've run into the same problem but the suggested method that worked last time seems unsuccessful with this.

The macros are as follows:

Sub RawStockUsage_Temp()


    If MsgBox("A mûvelet végrehajtása akár pár percet is igénybe vehet. Folytatod?", vbYesNo) = vbNo Then Exit Sub


    Worksheets("RawStockUsage_Temp").Range("A1:B92").Value = Worksheets("RawMat_Temp").Range("M6:N97").Value


    Sheet20.Range("O6:P97").Copy
    Sheet21.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


    Sheet20.Range("Q6:R97").Copy
    Sheet21.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


    Sheet20.Range("S6:T97").Copy
    Sheet21.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


    ThisWorkbook.Worksheets("RawStockUsage_Temp").Sort.SortFields.Clear
    ThisWorkbook.Worksheets("RawStockUsage_Temp").Sort.SortFields.Add Key _
        :=Range("A1:A400"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ThisWorkbook.Worksheets("RawStockUsage_Temp").Sort
        .SetRange Range("A1:B400")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Call Sheet21.RawStockdelrowsifzero
        
    Call Sheet19.CopyRawUsage
    
    MsgBox "Megérte várni, minden sikeresen rögzítésre került :)"
    
End Sub

And the subs to be called:

Sub RawStockdelrowsifzero()


    Dim rng As Range
    Dim i As Long
        Set rng = Worksheets("RawStockUsage_Temp").Range("B1:B500")
    With rng
        For i = .Rows.Count To 1 Step -1
            If .Item(i) = 0 Then
                .Item(i).EntireRow.Delete
            End If
        Next i
    End With
    
End Sub

Sub CopyRawUsage()


    Worksheets("NyersanyagRaktarTeteles").Range("C6:C500").Value = Worksheets("NyersanyagRaktarTeteles").Range("N6:N500").Value
        
    Worksheets("RawStockUsage_Temp").Range("A1:B500").ClearContent
    
End Sub

The error message comes up after running the RawStockdelrowsifzero.

Thank you for your efforts in advance.

Balazs

 

[RoryA]

Which specific line causes the error?

Please note the closing code tag is [/code] and not [\code]