下标超出范围 VBA excel

Question

I keep getting "subscript out of range" error. It occurs when I'm calling sSheetnaam . How can I solve this?

    Private Sub CommandButton4_Click()
Dim z As Integer
Dim sLogOpslaan As String
Dim wb As Workbook
Dim sSheetnaam As String
Dim sLocatieOpslaan As String
Dim sProductnummerMap As String
Dim result As String
Dim q As Integer

'prodct data toevoegen

Dim sB As String
Dim sC As String
Dim sD As String
Dim sE As String
Dim sF As String
Dim sG As String
Dim sH As String
Dim sI As String
Dim sJ As String
Dim sM As String

'Opslaan macro
Sheets("MainSheet").Select

Range("K9").Select
z = 0
Do While z < 20
    If ActiveCell.Value = "" Then
        ActiveCell.Offset(1, 0).Select
        z = z + 1
            Else:
            'Controleren of de handmeting aanwezig is
                If ActiveCell.Offset(0, -1).Value = "" Then
                    Response = MsgBox(prompt:="Handmeting ontbreekt, toch opslaan?", Buttons:=vbYesNo)
                        If Response = vbNo Then
                            MsgBox ("Voer eerst de handmeting in, of selecteer deze meting niet")
                            GoTo EindeOpslaan
                             Else:
                        End If
                End If

                'Controleren of de CNC meting aanwezig is
                If ActiveCell.Offset(0, -2).Value = "" Then
                    Response = MsgBox(prompt:="CNC Meting ontbreekt, toch opslaan?", Buttons:=vbYesNo)
                        If Response = vbNo Then
                            MsgBox ("Voer eerst de CNC meting in, of selecteer deze meting niet voor het opslaan")
                            GoTo EindeOpslaan
                                Else:
                        End If
                End If
            'Logboek Bijwerken
            sSheetnaam = ActiveCell.Offset(0, -4).Value
            sLogOpslaan = ActiveCell.Offset(0, 1).Value
            sProductnummerMap = ActiveCell.Offset(0, -7).Value
            Sheets("DataLog").Select
            Sheets("DataLog").Range("L2").Select
            Do While ActiveCell.Value <> sLogOpslaan
                    If ActiveCell.Value <> sLogOpslaan Then
                        ActiveCell.Offset(1, 0).Select
                    End If
                    If ActiveCell.Value = "" Then
                        GoTo EindeOpslaan
                    End If
                    If ActiveCell.Value = sLogOpslaan Then
                        ActiveCell.Offset(0, -1) = "X"
                        ActiveCell.Offset(0, -10) = Now
                        'Gegevens onthouden
                        sB = ActiveCell.Offset(0, -10).Value
                        sC = ActiveCell.Offset(0, -9).Value
                        sD = ActiveCell.Offset(0, -8).Value
                        sE = ActiveCell.Offset(0, -7).Value
                        sF = ActiveCell.Offset(0, -6).Value
                        sG = ActiveCell.Offset(0, -5).Value
                        sH = ActiveCell.Offset(0, -4).Value
                        sI = ActiveCell.Offset(0, -3).Value
                        sJ = ActiveCell.Offset(0, -2).Value
                        sM = ActiveCell.Offset(0, 1).Value
                        GoTo Gevonden
                    End If
                Loop
'Product gegevens toevoegen aan de sheet

Sheets(sSheetnaam).Select
    q = 0
    Do While q < 15
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        q = q + 1
    Loop

With Sheets(sSheetnaam)
    .Range("A1") = sB
    .Range("A2") = sC
    .Range("A3") = sD
    .Range("A4") = sE
    .Range("A5") = sF
    .Range("A6") = sG
    .Range("A7") = sH
    .Range("A8") = sI
    .Range("A9") = sJ
    .Range("A10") = sM
End With

Gevonden:
            'Hele rij leeg maken
            Sheets("MainSheet").Select
            sLocatieOpslaan = Range("P5").Value
            With ActiveCell
                .Offset(0, -1).Value = ""
                .Offset(0, -2).Value = ""
                .Offset(0, -3).Value = ""
                .Offset(0, -4).Value = ""
                .Offset(0, -5).Value = ""
                .Offset(0, -6).Value = ""
                .Offset(0, -7).Value = ""
                .Offset(0, -8).Value = ""
            End With

        'Kijken of de map al bestaat, als deze nog niet bestaat nieuwe maken
        If Dir(sLocatieOpslaan & "\" & sProductnummerMap & "\", 16) <> vbNullString Then
            Else
                MkDir (sLocatieOpslaan & "\" & sProductnummerMap & "\")
        End If

        If ActiveCell.Value <> "" Then
            Sheets(sSheetnaam).Select
            Application.AskToUpdateLinks = False
            Application.DisplayAlerts = False
            Workbooks.Add
            ThisWorkbook.Sheets(sSheetnaam).Copy Before:=ActiveWorkbook.Sheets(1)
            'MsgBox (sLocatieOpslaan & "\" & sSheetnaam & ".xlsx")
            Application.DecimalSeparator = ","
            ActiveWorkbook.SaveAs Filename:=sLocatieOpslaan & "\" & sProductnummerMap & "\" & sLogOpslaan & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True

            ActiveWorkbook.Close
            'de opgeslagen sheet verwijderen
            ActiveWindow.SelectedSheets.Delete
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
        End If
        Sheets("MainSheet").Select
        ActiveCell.Value = ""
    End If
Loop

EindeOpslaan:

End Sub

I needed to add extra lines because the post existed mostly of code lines... But I don't want to skip to much parts from the code... Then probably the problem couldn't be found. I allready skipped the majority of the code.

Answer 1

I suspect your use of Select is throwing a wrench in your wheels.

Change this snippet:

sSheetnaam = ActiveCell.Offset(0, -4).Value
sLogOpslaan = ActiveCell.Offset(0, 1).Value

To this:

sSheetnaam = ActiveCell.Offset(0, -4).Value
Debug.Print "Address: " & ActiveCell.Offset(0, -4).Address & ", with value " & ActiveCell.Offset(0, -4).Value  
Debug.Print sSheetnam
sLogOpslaan = ActiveCell.Offset(0, 1).Value

Set a breakpoint on sLogOpslaan and run the sub. Once it stops, inspect the debug results. Verify that the address of ActiveCell.Offset(0, 4) is the same as what you were expecting. Then, do the same for the value. If the values match, compare them to the line containing the contents of sSheetnaam .

My guess is that the address will be wrong, but if it's not, post more information so we can find out why the variable doesn't contain the correct value.