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?