How to fix "Run-time Error '9': Subscript out of Range"?

C

cs1810

New Member
Joined
May 5, 2015
Messages
14
Hi Everyone,

I have a script that is reformatting a dataset for me however i keep getting "Run-time Error '9': Subscript out of Range".

The guy who designed the code is no longer with the company so i'm attempting to spot fix the issue for the purpose of completing a project i'm working on.

It'd be great if i could get some help from you guys on this, i've pasted the code below. I highlighted the text red where the debugger picks up the issue.

Thanks,
Chris

Code: 
Sub ReformatGizmo()
Dim crtRow As Range
Dim crtColumn As Range
Dim crtPaste As Range
Dim segColumn As Range
Dim crtValue As Variant
Dim segValue As Variant
Dim crtItem As String
Dim nbSegments As Integer
Dim NbLines As Long
Dim crtPercil As Integer
Dim importSheet As Worksheet
Dim TimeStartedOffset As Integer
Dim ResponseIDOffset As Integer


Application.ScreenUpdating = False
Application.Calculation = xlManual


Set importSheet = ActiveSheet
[B][COLOR=#ff0000]Sheets("GizmoBis").UsedRange.Offset(1, 0).Delete[/COLOR][/B]


GoTo skipFormatting


'reformat UTF
Set myCell = Sheets("UTF").Range("A1")
Do While myCell <> ""
    importSheet.Cells.Replace What:=myCell, Replacement:=myCell.Offset(0, 1), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Set myCell = myCell.Offset(1, 0)
    Loop


'gizom values starting with +/- signs are imported as formula => replace by apostrophe
On Error Resume Next
importSheet.UsedRange.Replace What:="=-", Replacement:="'-", LookAt:=xlPart
importSheet.UsedRange.Replace What:="=+", Replacement:="'+", LookAt:=xlPart
On Error GoTo 0


'Update Regions in Gizmo Data
A = Application.WorksheetFunction.Match("Region", importSheet.Range("1:1"), 0)
B = Application.WorksheetFunction.Match("Country", importSheet.Range("1:1"), 0)
C = Application.WorksheetFunction.Match("Subsidiary from URL", importSheet.Range("1:1"), 0)


On Error GoTo errCountryNotListed
Set myRange = Intersect(importSheet.Range("A:A"), importSheet.UsedRange)
Set myRange = myRange.Offset(1, 0).Resize(myRange.Rows.Count - 1, 1)
For Each myCell In myRange
    'If no Country, take Subsidiary
    If myCell.Offset(0, B - 1) = "" Then
        myCell.Offset(0, B - 1) = myCell.Offset(0, C - 1)
        End If
    If myCell.Offset(0, B - 1) <> "" And myCell.Row > 1 Then
        myCell.Offset(0, A - 1).Formula = Application.WorksheetFunction.VLookup(myCell.Offset(0, B - 1), Range("CountryRegion"), 2, 0)
        End If
    Next myCell


A = Application.WorksheetFunction.Match("Arkadin Region", importSheet.Range("1:1"), 0)
B = Application.WorksheetFunction.Match("Subsidiary from URL", importSheet.Range("1:1"), 0)
C = Application.WorksheetFunction.Match("Country", importSheet.Range("1:1"), 0)


For Each myCell In myRange
    'If no Subsidiary, take Country
    If myCell.Offset(0, B - 1) = "" Then
        myCell.Offset(0, B - 1) = myCell.Offset(0, C - 1)
        End If
    If myCell.Offset(0, B - 1) <> "" And myCell.Row > 1 Then
        myCell.Offset(0, A - 1).Formula = Application.WorksheetFunction.VLookup(myCell.Offset(0, B - 1), Range("CountryRegion"), 2, 0)
        End If
    Next myCell
On Error GoTo 0


skipFormatting:


Sheets("PercentDone").Visible = xlSheetVisible
Sheets("PercentDone").Activate
Sheets("PercentDone").Range("PercentDone").EntireRow.Interior.ColorIndex = 0
NbLines = Application.WorksheetFunction.CountA(importSheet.Range("A:A"))
crtPercil = 0
Sheets("PercentDone").Range("PercentDone").Select


'-------------START OF DATA IMPORT
Set crtPaste = Sheets("GizmoBis").Range("A2")
nbSegments = Application.WorksheetFunction.CountA(Sheets("GizmoBis").Range("1:1")) - 4 '4 value/data column
ResponseIDOffset = SegmentColumn("Response ID") - 1
TimeStartedOffset = SegmentColumn("Time Started") - 1


For Each crtRow In Range(importSheet.Range("A2"), importSheet.Range("A1").End(xlDown))


    ' display progress bar
    If (crtRow.Row / NbLines) >= (crtPercil / 40) Then
        Selection.Interior.ColorIndex = 1
        Selection.Offset(0, 1).Select
        crtPercil = crtPercil + 1
        Application.ScreenUpdating = True
        DoEvents
        Application.ScreenUpdating = False
        End If
    
    For Each crtColumn In Range(importSheet.Range("B1"), importSheet.Range("B1").End(xlToRight))
        crtValue = importSheet.Cells(crtRow.Row, crtColumn.Column)
        
        ' create line only if value and not a segment and not excluded label (underscore)
        If crtValue <> "" And SegmentColumn(crtColumn.Value) = 0 And Left(crtColumn.Value, 1) <> "_" Then
            crtPaste = crtRow
            
            ' get segments first
            If crtRow.Offset(0, ResponseIDOffset) <> crtPaste.Offset(-1, ResponseIDOffset) Then
                For Each segColumn In Range(importSheet.Range("B1"), importSheet.Range("B1").End(xlToRight))
                segValue = importSheet.Cells(crtRow.Row, segColumn.Column)
                    B = SegmentColumn(segColumn.Value)
                    If B > 0 Then
                        If segValue = "" Or Not (IsDate(segValue) Or IsNumeric(segValue)) Then
                            segValue = Right(segValue, Len(segValue) - InStrRev(segValue, ":"))
                            crtPaste.Offset(0, B - 1) = crtPaste.Offset(0, B - 1) _
                            & IIf(crtPaste.Offset(0, B - 1) = "", "", "|") _
                            & IIf(segValue = "", "<>", WorksheetFunction.Trim(segValue))
                            Else
                            crtPaste.Offset(0, B - 1) = segValue
                            End If
                        End If
                Next segColumn
            Else
                crtPaste.Offset(-1, 0).Resize(1, nbSegments).Copy (crtPaste.Resize(1, nbSegments))
            End If
            
            ' then get item/subitem
            A = InStrRev(crtColumn, ":")
            If A = 0 Then
                crtPaste.Offset(0, nbSegments) = crtColumn
            Else
                crtPaste.Offset(0, nbSegments) = Right(crtColumn, Len(crtColumn) - A)
                crtPaste.Offset(0, nbSegments + 1) = Left(crtColumn, A - 1)
            End If
            
            ' then get value and bucket
            crtPaste.Offset(0, nbSegments + 2) = crtValue
            If crtColumn = "Date Submitted" Then
                'Date Submitted becomes nb minutes to respond
                crtPaste.Offset(0, nbSegments + 3) = (crtValue - crtPaste.Offset(0, TimeStartedOffset)) * 1440
                Else
                crtPaste.Offset(0, nbSegments + 3) = crtValue
                End If
            Set crtPaste = crtPaste.Offset(1, 0)
            End If
    Next crtColumn
        
Next crtRow


' create Satisfaction promoters/demoters groups
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Very satisfied", Replacement:="Promoters", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Satisfied", Replacement:="Promoters", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Neither satisfied nor dissatisfied", Replacement:="Neutrals", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Dissatisfied", Replacement:="Detractors", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Very dissatisfied", Replacement:="Detractors", LookAt:=xlWhole


' create Satisfaction 1-5 scale
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Very satisfied", Replacement:="5", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Satisfied", Replacement:="4", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Neither satisfied nor dissatisfied", Replacement:="3", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Dissatisfied", Replacement:="2", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Very dissatisfied", Replacement:="1", LookAt:=xlWhole


' create Agreement promoters/demoters groups
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Strongly agree", Replacement:="Promoters", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Agree", Replacement:="Promoters", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Neither agree nor disagree", Replacement:="Neutrals", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Disagree", Replacement:="Detractors", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 3).Replace _
    What:="Strongly disagree", Replacement:="Detractors", LookAt:=xlWhole


' create Agreement 1-5 scale
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Strongly agree", Replacement:="5", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Agree", Replacement:="4", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Neither agree nor disagree", Replacement:="3", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Disagree", Replacement:="2", LookAt:=xlWhole
Sheets("GizmoBis").Range("A:A").Offset(0, nbSegments + 2).Replace _
    What:="Strongly disagree", Replacement:="1", LookAt:=xlWhole


A = Application.WorksheetFunction.Match("Administrators", Sheets("GizmoBis").Range("1:1"), 0) - 1
Sheets("GizmoBis").Range("A:A").Offset(0, A).Replace _
    What:="Please select if you have responsibility for buying or administrating collaboration solutions for your company." _
    , Replacement:="X", LookAt:=xlWhole


A = Application.WorksheetFunction.Match("Which of the following product(s) do you use?", Sheets("GizmoBis").Range("1:1"), 0) - 1
Sheets("GizmoBis").Range("A:A").Offset(0, A).Replace What:="|<>", Replacement:="", LookAt:=xlPart
Sheets("GizmoBis").Range("A:A").Offset(0, A).Replace What:="<>|", Replacement:="", LookAt:=xlPart




Sheets("GizmoBis").Range("A1").CurrentRegion.Name = "Gizmo"
importSheet.Range("A1").CurrentRegion.Name = "GizmoRaw"
Sheets("PercentDone").Visible = xlSheetHidden
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Exit Sub


errCountryNotListed:
Application.ScreenUpdating = True
Sheets("CountryRegion").Range("2:2").Insert
Sheets("CountryRegion").Range("A2").Formula = myCell.Offset(0, B - 1)
Sheets("CountryRegion").Range("B2").Formula = InputBox("Assign " & myCell.Offset(0, B - 1) & " to:", "Missing Country", "EMEA")
Application.ScreenUpdating = False
Resume


End Sub




Private Function SegmentColumn(Item As String) As Integer


Item = Right(Item, Len(Item) - InStrRev(Item, ":"))


On Error GoTo Not_a_segment
SegmentColumn = Application.WorksheetFunction.Match(Item, Sheets("GizmoBis").Range("1:1"), 0)
On Error GoTo 0
Exit Function


Not_a_segment:
SegmentColumn = 0
Resume Next


End Function




Private Function CountRespondents(Item As String) As Long
A = Application.WorksheetFunction.Match("Item", Sheets("GizmoBis").Range("1:1"), 0) - 1
crtID = 0
For Each myCell In Range("Gizmo").Resize(Range("Gizmo").Rows.Count, 1)
    If myCell.Offset(0, A) = Item And myCell <> crtID Then
        CountRespondents = CountRespondents + 1
        crtID = myCell
        End If
    Next
End Function


Private Function NPS(myRange As Range, Low As Integer, High As Integer) As Variant


If myRange.Columns.Count <> 11 Then Exit Function


p = Application.WorksheetFunction.Sum(myRange.Offset(0, High).Resize(1, 11 - High))
D = Application.WorksheetFunction.Sum(myRange.Resize(1, 1 + Low))
t = Application.WorksheetFunction.Sum(myRange)
'Debug.Print p, d, t
If t > 0 Then
    NPS = (p - D) / t * 100
    Else
    NPS = CVErr(xlErrNA)
    End If
    
End Function


Private Sub ChangeLabels()
xVals = ActiveChart.SeriesCollection(Selection.Name).Formula
    xVals = Right(xVals, Len(xVals) - InStr(1, xVals, ",", vbTextCompare))
    xVals = Left(xVals, InStr(1, xVals, ",", vbTextCompare) - 1)
    For Counter = 1 To Range(xVals).Cells.Count
    mylabel = Format(Range(xVals).Offset(0, -1).Cells(Counter), "0")
    With ActiveChart.SeriesCollection(Selection.Name).Points(Counter)
    .HasDataLabel = True
    .DataLabel.Text = mylabel
    '.DataLabel.Position = xlLabelPositionInsideEnd
    '.DataLabel.Top = .DataLabel.Top - 30
    End With
    Next
End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
Do you have a sheet called GizmoBis and if you think you do is there a space either before or after the name.
 
Upvote 0
Hi, GizmoBis is the tab that the code creates as one of it's processes. However i attempted running the macro without this new tab, and again manually adding the tab, and both time leads to the same runtime error.

To give some context; the purpose of the script is to change a dataset that has been downloaded from the results of a customer survey in SurveyGizmo. The problem with the raw data is that each question and all of it's possible answers are in the columns, which is horrible for summarising the results. So this code changes the format by putting all the responses into rows. There are other factors going on but that is the basic premise.
 
Last edited:
Upvote 0
Chris

Where/when is the sheet 'GizmoBis being created?
 
Upvote 0
cs1810 said:
Hi, GizmoBis is the tab that the code creates as one of it's processes.
Click to expand...

cs1810 said:
Hey, it's being created in the same worksheet as the raw data, but in a new tab.
Click to expand...

Where exactly in the code is it being created? post/repost the part of the code where it is being created.
 
Last edited:
Upvote 0
I don't know, the person who wrote it is no longer with the company. Hoping someone here can help.
 
Upvote 0
We are asking because we can't see it being created anywhere.

In the project explorer window what is outside the brackets where GizmoBis is inside the brackets (see the image below).

 
Upvote 0
Oh okay, my bad...i understand now. I just took a screenshot so hopefully this will help. I tried creating the GizmoBis tab manually to see if this would help. The first time i tried i didn't get a subscript error but rather a "copy method of range class failed" error. Then when i tried to run it again i got the subscript error again.

Capture.jpg
 
Upvote 0
In that screenshow I'm not seeing a worksheet with the tab name 'GizmoBis' and that's what's causing the error.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
VBA Macros running slow out of nowhere
Replies
3
Views
215
mumps
mumps
B
  • Question
Subscript Out of Range - Update Sheet Name (VBA)
2
Replies
10
Views
675
kevin9999
K
M
  • Question
search in worksheet for multiple words via userform
Replies
6
Views
334
Max01
M
S
  • Question
"Subscript out of range ( Run time Error: 09)" Problem in My Excel VBA
Replies
5
Views
272
6StringJazzer
6StringJazzer
S
  • Solved
Error due to missing date
Replies
3
Views
287
saracat2012
S

Forum statistics

Threads
1,215,035
Messages
6,122,785
Members
449,095
Latest member
m_smith_solihull

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