Compiling Data From A Filtered Worksheet Pt2

[Ark68]

In this post from the end of February, I sought help looking for a means of compiling data from a filtered range in a worksheet. Dante was so kind as to provide me a VBA solution, that for the purpose of the original post worked wonderfully. Being a novice to VBA, he provided a solution that was very unique to me and although he did provide an explanation as to how it worked, it still was challenging to figure out.

I need to expand my needs now from the original post by having to compile a couple more sets of data, but I'm challenged with adapting the code to accommodate these changes.

The original code assesses filtered data (by date in column B) in worksheet "ops", identifies unique values in column L (Account). With each unique value found, it sums the values (if not "MIN" in column) in column N (Salt), and if the value is "MIN" provides a count. It also sums the values (if not "MIN" in column) in column O (Sand), however does not provide a count of "MIN" like it does for column N. It then posts the compiled data to worksheet "weeks" at cell A31. Column A represents the dictionary values (account) ; B the sum of values in column N (salt total); C to the sum of values in column O (sand total); and D the count of "MIN" in column N salt MIN count).

I need to do two more thing things. I need to compile a count of instances that each value in the dictionary is found (column L) and a count of "MIN" for column "O". I hope someone can help.

The data will be posted to worksheet weeks in this manner
A31 - Column L (account values)
B31 - Count of Column L (count of each unique account found)
C31 - Sum of Column N (sum of salt)
D31 - Count of MIN in Column N (count of MIN occurrences)
E31 - Sum of Column O (sum of sand)
F31 - Count of MIN in Column N (count of MIN occurrences)

Here is my feeble attempt ...
First problem: I get a "Subscript out of range" error with the line in red. The workbook that holds both the OPS and WEEKS worksheets is hidden. If the workbook is visible, I don't get the error. For this to work, is it necessary to have that workbook open as it appears? I'd prefer to be able to leave it hidden from the user.

Sub CompilingData()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
Stop
  Set dic = CreateObject("Scripting.Dictionary") 'create a dictionary - a list that holds the account values as the loop (i) encounters them
  a = Sheets("OPS").Range("L2:O" & Sheets("OPS").Range("L" & Rows.Count).End(3).Row).SpecialCells(xlCellTypeVisible).Value '
  ReDim b(1 To UBound(a, 1), 1 To 5)

  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then dic(a(i, 1)) = dic.Count + 1 'dic
    j = dic(a(i, 1)) 'the account value (a~row)
    b(j, 1) = a(i, 1) 'the account value
    If a(i, 3) <> "MIN" Then
        b(j, 2) = b(j, 2) + a(i, 3)
    Else
        b(j, 4) = b(j, 4) + 1
    End If
    If a(i, 4) <> "" Then
        b(j, 3) = b(j, 3) + a(i, 4)
    End If
  
    If a(i, 4) <> "MIN" Then
        b(j, 3) = b(j, 3) + a(i, 4)
    Else
        b(j, 5) = b(j, 5) + 1
    End If
    If a(i, 4) <> "" Then
        b(j, 4) = b(j, 4) + a(i, 5)
    End If
  
  Next
  With Sheets("WEEKS")
    .Activate
    .Range("A32").Resize(dic.Count, 5).Value = b
    .Range("A31").Resize(dic.Count + 1, 5).Sort Key1:=.Range("A31"), Order1:=xlAscending, Header:=xlYes
  End With
End Sub

Sample Data:

2021-2022 Data.xlsx
	L	M	N	O
295	ARC	PL ST	MIN
296	SP	PL ST	MIN
297	WMRC	PL ST	0.125
298	SP	PL ST	0.125
299	WP	PL ST	0
300	CW	PL ST	MIN
301	SP	PL ST	0.25
302	CW	PL ST	0.125
303	BIA	PL ST	MIN
304	ARC	PL ST	MIN
305	UPP	PL ST	0.125
306	WTS	PL ST	MIN
307	SP	PL ST	0.125
308	WP	PL ST	0.125
309	CW	PL ST	0.125
310	SP	PL ST	MIN
311	CW	PL		0.25
312	SP	PL		0.5
313	CW	PL		MIN
314	CW	PL		0.125
315	SP	PL		0.25
316	CW	PL		MIN
317	SP	[PL]		MIN
322	CW	[PL] [ST]	0.5
866	CW	PL ST	0.125
867	SP	PL ST	0.125
918	CW	PL ST	0.25
OPS

This is the result:

2021-2022 Data.xlsx
	A	B	C	D	E	F
31	Account	Count	Salt	MIN	Sand	MIN
32	ARC	0.25	0
33	CCGG		0	1
34	CW	0.575	0	1
35	UPP		0	1
36	WP	0.25	0
37	WTS		0	1
WEEKS

This I believe is how it should look like:

2021-2022 Data.xlsx
	A	B	C	D	E	F
31	Account	Count	Salt	MIN	Sand	MIN
32	ARC			2
33	BIA			1
34	CW		1.075	1	0.375	2
35	SP		0.575	2	0.75	1
36	UPP		0.125
37	WMRC		0.125
38	WP		0.125
39	WTS			1
WEEKS

Not shown in this table is the count of accounts which will fill range(B32:B39) respectively.

 

[Ark68]

Bump

 

[Ark68]

It took me awhile but I figured out how these array's worked. I came up with this code.

Sub CompilingData()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long

  Set dic = CreateObject("Scripting.Dictionary") 
  [color=red]a = Sheets("OPS").Range("L2:O" & Sheets("OPS").Range("L" & Rows.Count).End(3).Row).SpecialCells(xlCellTypeVisible).Value [/color]'
  ReDim b(1 To UBound(a, 1), 1 To 6) '1 - Accnt, 2 - account count, 3 - salt sum, 4 - salt MIN, 5 - sand sum, 6 - sand MIN

  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then dic(a(i, 1)) = dic.Count + 1 'dic
    j = dic(a(i, 1)) 'the account value (a~row)
    b(j, 1) = a(i, 1) 'the account value

    'salt
    b(j, 2) = b(j, 2) + 1
    If a(i, 3) <> "MIN" Then                    
        b(j, 3) = b(j, 3) + a(i, 3) 'salt tally = salt tally + value taken from column 3 (salt) of range
    Else
        b(j, 4) = b(j, 4) + 1 'increment SALT min (destination) count
    End If
    
    'If a(i, 4) <> "" Then
    '    Debug.Print "b(j, 3): " & b(j, 3)
    '    b(j, 3) = b(j, 3) + a(i, 4)
    'End If
    
    'sand
    If a(i, 4) <> "MIN" Then 
        b(j, 5) = b(j, 5) + a(i, 4) 'salt tally = salt tally + value taken from column 4 (salt) of range
    Else
        b(j, 6) = b(j, 6) + 1
    End If
    
    'If a(i, 4) <> "" Then
    '    b(j, 4) = b(j, 4) + a(i, 5)
    'End If
    
  Next
  With Sheets("WEEKS")
    .Activate
    .Range("A32").Resize(dic.Count, 6).Value = b
    .Range("A31").Resize(dic.Count + 1, 6).Sort Key1:=.Range("A31"), Order1:=xlAscending, Header:=xlYes
  End With
End Sub

Unfortunately I still have some issues and as such as I've loosely cross posted here seeking support problems with access to the filtered data.