Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

subscript out of range

0

hi

this  code   works  very  well  before I  add  sheet RSS . actually  I  mod two lines  , but  it  gives  error  in this  line 

If IsNumeric(vals(j + 3)) Then

I  mod two  lines  this 

 ShList = Split("stock|sales|pur|returns|rss", "|")
.FormulaR1C1 = "=RC[-5]+RC[-4]-RC[-3]+RC[-2]+RC[-1]"

the  idea  of  code  is calculate  the  values  for  all brand  across multiple  sheets  and  show  the  result  in summary .

Sub CollateData_v4()
  Dim d As Object
  Dim ShList As Variant, a As Variant, vals As Variant
  Dim i As Long, j As Long
  Dim s As String
  Dim tm As Double
  tm = Timer
  Set d = CreateObject("Scripting.Dictionary")
  ShList = Split("stock|sales|pur|returns|rss", "|")
  For j = 0 To UBound(ShList)
    With Sheets(ShList(j))
      a = .UsedRange.Value2
      For i = 2 To UBound(a)
        s = .Cells(i, 2)
        If Len(s) > 2 Then

        If Not d.exists(s) Then d(s) = Join(Application.Index(a, i, Array(3, 4, 5)), ";") & ";;;;"
          vals = Split(d(s), ";")
          If IsNumeric(vals(j + 3)) Then
           vals(j + 3) = vals(j + 3) + a(i, 6)
           Else
           vals(j + 3) = a(i, 6)
          End If

            d(s) = Join(vals, ";")

        End If
      Next i
    End With
  Next j
  Application.ScreenUpdating = False
  With Sheets("summary")
    .UsedRange.EntireRow.Delete
    With .Range("B2:C2").Resize(d.Count)
      .Value = Application.Transpose(Array(d.Keys, d.Items))
      With .Columns(2)
        .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
        With .Offset(, 7) ' ### was .Offset(, 5)
          .FormulaR1C1 = "=RC[-5]+RC[-4]-RC[-3]+RC[-2]+RC[-1]"
          .Value = .Value
        End With
        '.Resize(, 3).EntireColumn.Insert '### not needed
      End With
      .Columns(1).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      With .Columns(0)
        .Cells(1).Value = 1
        .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
      End With
    End With
    With .Range("A1:J1")
      .Value = Array("item", "CODE", "BRAND", "TYPE", "MANUFACTURE", "STOCK", "SALES", "PUR", "RETURNS", "BALANCE")
       .Font.Bold = True
  .Interior.Color = RGB(166, 166, 166)
      .EntireColumn.AutoFit
    End With
    With .UsedRange
      .BorderAround xlContinuous
      .Borders(xlInsideVertical).LineStyle = xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
  End With
  Application.ScreenUpdating = True
  MsgBox Format(Timer - tm, "0.00")
End Sub

any  help  ,please?

Answer
Discuss

Answers

0
Selected Answer

Leap

The error arose in the line:

If IsNumeric(vals(j + 3)) Then

since with j=4 (the number of search sheets including the new rss), it looked for vals(7) which did not exist.

Furthermore (since you found a doubling effect in some figures), I realised that IsNumeric is the wrong test to use when a new dictionary item d is created. IsNumeric actually tests if a value can be converted to a number (not that it really IS a number). Therefore Isnumeric gives TRUE for a string value (say "100"), Isnumeric and it gets added to itself in the line

vals(j + 3) = vals(j + 3) + a(i, 6)
The Excel worksheet function IsNumber actually tests if a value is a number but the appropriate test (for an existing dictionary item) is simply to see if the split array value is "" or not. That is shows below in bold in the code section which records/adds sheet values into dictionary entries:
For j = 0 To UBound(ShList)
    With Sheets(ShList(j))
        a = .UsedRange.Value2
        For i = 2 To UBound(a)
            s = .Cells(i, 2)
            If Len(s) > 2 Then
                ' changed code for value assignment/ addition
                If Not d.exists(s) Then
                    'change array in dictionary, just create dictionary entry
                    d(s) = Join(Application.Index(a, i, Array(3, 4, 5, 6)), ";") & ";;;;"

                    Else
                    vals = Split(d(s), ";")
                        ' see if there's a value against this sheet already
                        If vals(j + 3) <> "" Then
                            'if so, add this value
                            vals(j + 3) = vals(j + 3) + a(i, 6)
                            Else
                            'if not, record this value
                            vals(j + 3) = a(i, 6)
                        End If
                    'save updated dictionary entry
                    d(s) = Join(vals, ";")
                End If
            End If
        Next i
    End With
Next j

The attached file has a few minor changes to the macro (and summary sheet cleared initially). I've up-versioned the macro name to v7 now. Also the formula is modified to the one discussed below:
    With .Offset(, 8) ' move one column to right so formula gets only numbers
        .FormulaR1C1 = "=RC[-5]-RC[-4]+RC[-3]+RC[-2]-RC[-1]"
        .Value = .Value
    End With
Hope this finally fixes things for you.
Discuss

Discussion

thanks, but  I  note  in column STOCK in sheet  SUMMARY  sum  the  values  twices despite  of  there  is  no  duplicate  items  to  merge  and  sum .
what  happens?
leap (rep: 46) Dec 4, '21 at 2:59 am
Leap. I'll look at it today.

Actually many of the category values are doubled but NOT the figures in Returns and rss (which add correctly).
John_Ru (rep: 6142) Dec 4, '21 at 3:26 am
Leap

I think I've fixed it. Please see my revised Answer (especially the bit beginning "Furthermore...") and new file. Please check everything add up correctly.

Also I suspect that the Sales value should be subtracted so the formula line would read:
.FormulaR1C1 = "=RC[-5]-RC[-4]+RC[-3]+RC[-2]+RC[-1]"
but I may not understand your numbers.
John_Ru (rep: 6142) Dec 4, '21 at 4:32 am
sorry  John  . I  say this  doesn't fix  it . the  orginal  code  deals  with  the  duplicate  items    it   will merge  and  sum   . this  is  very  important  . sometime   there  is  repeated  items  so  the  code  deals with  this  case . if  you  see  the  orginal  code  does  that  without  sum  twice  in  column  stock  because  there  are no  duplicate  items. I  hope  to  explained  clearly  my  idea.
leap (rep: 46) Dec 4, '21 at 4:42 am
Sorry Leap. I gave some rushed answers (then deleted them). I will look later but assume you want "merge and sum" where CODE, BRAND, TYPE and MANUFACTURE all match, right?

What's your reply on my question about the formula (see above)
John_Ru (rep: 6142) Dec 4, '21 at 5:06 am
sorry  about  the  formula  should be
.FormulaR1C1 = "=RC[-5]-RC[-4]+RC[-3]+RC[-2]-RC[-1]"

you want "merge and sum" where CODE, BRAND, TYPE and MANUFACTURE all match, right?
yes
leap (rep: 46) Dec 4, '21 at 7:51 am
Thanks, done that- see revised Answer/ file. I think it all works correctly now.
John_Ru (rep: 6142) Dec 4, '21 at 8:16 am
great achievement ! many thanks master.
leap (rep: 46) Dec 4, '21 at 9:25 am
Phew! Glad it worked in the end Leap. Have fun!
John_Ru (rep: 6142) Dec 4, '21 at 9:45 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login