VBA Code to display calculated data every second column with count in between

BigMillBoy · Sep 7, 2021

Hi,
I am looking for a way to display the cumulative duration of stops for each week by machine part in the table below. I would like to display the cumulative time in every second column with the number of times the stop occurred in the one next to it. I have already have a script that displays the cumulative duration but not the number of times it occurred which is required (see below).

Sheet: A_Stops

Test code.xlsm

A

B

C

1

Date

PART

DUR

2

1

A

200

3

1

B

15

4

1

C

150

5

1

A

125

6

1

B

175

7

1

C

300

8

1

A

20

9

1

B

120

10

2

A

50

11

2

C

400

12

2

B

60

13

2

B

300

14

2

C

130

15

3

A

55

16

3

A

370

17

3

A

20

18

3

B

15

A_Stops

My scrip:

VBA Code:

Sub CumStops()

    
    Dim wsA As Worksheet: Set wsA = Worksheets("A_Stops")
    Dim wsCA As Worksheet: Set wsCA = Worksheets("Cumlative_A")
    Dim lRow As Long, x As Long, lRow2 As Long, i As Long, c As Long
    Dim dts As Variant
    
    wsCA.Cells.ClearContents
    
    lRow = wsA.Cells(Rows.Count, 1).End(xlUp).Row
    dts = wsA.Range("A2:A" & lRow)


    With CreateObject("Scripting.Dictionary")
        For x = LBound(dts) To UBound(dts)
            If Not IsMissing(dts(x, 1)) Then .Item(dts(x, 1)) = 1
        Next
        dts = .Keys
    End With
    
    wsCA.Range("B1").Resize(, UBound(dts) + 1) = dts
    wsA.Range("B1:B" & lRow).Copy wsCA.Range("A1")
    wsCA.Range("A2:B" & lRow).RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlNo
    lRow2 = wsCA.Cells(Rows.Count, 1).End(xlUp).Row
    
    For c = 2 To 2 + UBound(dts)
        For i = 2 To lRow2
            wsCA.Cells(i, c) = Application.WorksheetFunction.SumIfs _
            (wsA.Range("C:C"), wsA.Range("A:A"), wsCA.Cells(1, c), _
            wsA.Range("B:B"), wsCA.Range("A" & i))
        Next
    Next
    
End Sub

Which gives this output:
Sheet: Cumlative_A

Test code.xlsm

A

B

C

D

1

PART

1

2

3

2

A

345

50

445

3

B

310

360

15

4

C

450

530

0

Cumlative_A

maabadi · Sep 7, 2021

Welcome to MrExcel Message Board.
How about Formula Method:

Book1

A

B

C

D

E

F

G

H

I

J

1

Date

PART

DUR

Sum

2

1

A

200

Unique Part

1

2

3

1

B

15

A

345

50

445

4

1

C

150

B

310

360

15

5

1

A

125

C

450

530

0

6

1

B

175

7

1

C

300

8

1

A

20

Counting

9

1

B

120

Unique Part

1

2

3

10

2

A

50

A

3

1

3

11

2

C

400

B

3

2

1

12

2

B

60

C

2

0

13

2

B

300

14

2

C

130

15

3

A

55

16

3

A

370

17

3

A

20

18

3

B

15

19

20

21

Sheet1

Cell Formulas
Range	Formula
G9:I9,F2:J2	F2	=IFERROR(INDEX($A$2:$A$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $A$2:$A$18),0,0), 0)), "")
F3:H5	F3	=SUMIFS($C$2:$C$18,$A$2:$A$18,F$2,$B$2:$B$18,$E3)
E3:E7	E3	=IFERROR(INDEX($B$2:$B$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $B$2:$B$18),0,0), 0)), "")
F9	F9	=IFERROR(INDEX($A$2:$A$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $A$2:$A$18),0,0), 0)), "")
F10:H12	F10	=COUNTIFS($A$2:$A$18,F$2,$B$2:$B$18,$E10)
E10:E13	E10	=IFERROR(INDEX($B$2:$B$18, MATCH(0,INDEX(COUNTIF($E$9:E9, $B$2:$B$18),0,0), 0)), "")

maabadi · Sep 7, 2021

Or all at One Table:

Book1

A

B

C

D

E

F

G

H

I

J

K

L

1

Date

PART

DUR

Sum

Count

Sum

Count

Sum

Count

2

1

A

200

Unique Part

1

1

2

2

3

3

3

1

B

15

A

345

3

50

1

445

3

4

1

C

150

B

310

3

360

2

15

1

5

1

A

125

C

450

2

530

2

0

0

6

1

B

175

7

1

C

300

8

1

A

20

9

1

B

120

10

2

A

50

11

2

C

400

12

2

B

60

13

2

B

300

14

2

C

130

15

3

A

55

16

3

A

370

17

3

A

20

18

3

B

15

19

20

Sheet1

Cell Formulas
Range	Formula
F2:K2	F2	=IF(MOD(COLUMN(),2)=0,IFERROR(INDEX($A$2:$A$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $A$2:$A$18),0,0), 0)), ""),E2)
F3:K5	F3	=IF(MOD(COLUMN(),2)=0,SUMIFS($C$2:$C$18,$A$2:$A$18,F$2,$B$2:$B$18,$E3),COUNTIFS($A$2:$A$18,F$2,$B$2:$B$18,$E3))
E3:E7	E3	=IFERROR(INDEX($B$2:$B$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $B$2:$B$18),0,0), 0)), "")

BigMillBoy · Sep 7, 2021

maabadi said:
Or all at One Table:

Book1
A B C D E F G H I J K L
1 Date PART DUR Sum Count Sum Count Sum Count
2 1 A 200 Unique Part 1 1 2 2 3 3
3 1 B 15 A 345 3 50 1 445 3
4 1 C 150 B 310 3 360 2 15 1
5 1 A 125 C 450 2 530 2 0 0
6 1 B 175
7 1 C 300
8 1 A 20
9 1 B 120
10 2 A 50
11 2 C 400
12 2 B 60
13 2 B 300
14 2 C 130
15 3 A 55
16 3 A 370
17 3 A 20
18 3 B 15
19
20
Sheet1
Cell Formulas
Range Formula
F2:K2 F2 =IF(MOD(COLUMN(),2)=0,IFERROR(INDEX($A$2:$A$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $A$2:$A$18),0,0), 0)), ""),E2)
F3:K5 F3 =IF(MOD(COLUMN(),2)=0,SUMIFS($C$2:$C$18,$A$2:$A$18,F$2,$B$2:$B$18,$E3),COUNTIFS($A$2:$A$18,F$2,$B$2:$B$18,$E3))
E3:E7 E3 =IFERROR(INDEX($B$2:$B$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $B$2:$B$18),0,0), 0)), "")
Sorry

maabadi said:

Or all at One Table:

Book1
A B C D E F G H I J K L
1 Date PART DUR Sum Count Sum Count Sum Count
2 1 A 200 Unique Part 1 1 2 2 3 3
3 1 B 15 A 345 3 50 1 445 3
4 1 C 150 B 310 3 360 2 15 1
5 1 A 125 C 450 2 530 2 0 0
6 1 B 175
7 1 C 300
8 1 A 20
9 1 B 120
10 2 A 50
11 2 C 400
12 2 B 60
13 2 B 300
14 2 C 130
15 3 A 55
16 3 A 370
17 3 A 20
18 3 B 15
19
20
Sheet1
Cell Formulas
Range Formula
F2:K2 F2 =IF(MOD(COLUMN(),2)=0,IFERROR(INDEX($A$2:$A$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $A$2:$A$18),0,0), 0)), ""),E2)
F3:K5 F3 =IF(MOD(COLUMN(),2)=0,SUMIFS($C$2:$C$18,$A$2:$A$18,F$2,$B$2:$B$18,$E3),COUNTIFS($A$2:$A$18,F$2,$B$2:$B$18,$E3))
E3:E7 E3 =IFERROR(INDEX($B$2:$B$18, MATCH(0,INDEX(COUNTIF($E$2:E2, $B$2:$B$18),0,0), 0)), "")

Click to expand...

I am looking to use vba code as it will need to be automated each week to a button. So simply adding formulas to each cell will not accomplish the task I have been set. Thanks though

maabadi · Sep 8, 2021

Try this:

VBA Code:

Sub ArrahngeData()
Dim i As Long, Lr As Long, Sh1 As Worksheet, Sh2 As Worksheet, Ar As Variant, Ar2 As Variant
Dim j As Long, Lr2 As Long
Set Sh1 = Sheets("A_Stops")
Set Sh2 = Sheets("Cumlative_A")
Sh2.Cells.ClearContents
Lr = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Ar = Sh1.Range("A2:A" & Lr)
 With CreateObject("Scripting.Dictionary")
        For i = LBound(Ar) To UBound(Ar)
            If Not IsMissing(Ar(i, 1)) Then .Item(Ar(i, 1)) = 1
        Next
        Ar = .Keys
End With
 For i = LBound(Ar) To UBound(Ar)
   Sh2.Cells(1, 2 * i + 2).Resize(, 2).Value = Array("Sum", "Count")
   Sh2.Cells(2, 2 * i + 2).Resize(, 2).Value = Ar(i)
 Next i
    Sh2.Range("A2:A" & Lr).Value = Sh1.Range("B1:B" & Lr).Value
    Sh2.Range("A3:B" & Lr).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    Lr2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 3 To Lr2
    For j = 2 To 2 * UBound(Ar) + 3
    If j Mod 2 = 0 Then
    Cells(i, j).Value = Application.WorksheetFunction.SumIfs(Sh1.Range("C:C"), Sh1.Range("A:A"), _
    Sh2.Cells(2, j), Sh1.Range("B:B"), Sh2.Range("A" & i))
    Else
    Cells(i, j).Value = Application.WorksheetFunction.CountIfs(Sh1.Range("A:A"), Sh2.Cells(2, j), _
    Sh1.Range("B:B"), Sh2.Range("A" & i))
    End If
    Next j
 Next i
End Sub

BigMillBoy · Sep 8, 2021

maabadi said:

Try this:

VBA Code:

Sub ArrahngeData()
Dim i As Long, Lr As Long, Sh1 As Worksheet, Sh2 As Worksheet, Ar As Variant, Ar2 As Variant
Dim j As Long, Lr2 As Long
Set Sh1 = Sheets("A_Stops")
Set Sh2 = Sheets("Cumlative_A")
Sh2.Cells.ClearContents
Lr = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Ar = Sh1.Range("A2:A" & Lr)
 With CreateObject("Scripting.Dictionary")
        For i = LBound(Ar) To UBound(Ar)
            If Not IsMissing(Ar(i, 1)) Then .Item(Ar(i, 1)) = 1
        Next
        Ar = .Keys
End With
 For i = LBound(Ar) To UBound(Ar)
   Sh2.Cells(1, 2 * i + 2).Resize(, 2).Value = Array("Sum", "Count")
   Sh2.Cells(2, 2 * i + 2).Resize(, 2).Value = Ar(i)
 Next i
    Sh2.Range("A2:A" & Lr).Value = Sh1.Range("B1:B" & Lr).Value
    Sh2.Range("A3:B" & Lr).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    Lr2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 3 To Lr2
    For j = 2 To 2 * UBound(Ar) + 3
    If j Mod 2 = 0 Then
    Cells(i, j).Value = Application.WorksheetFunction.SumIfs(Sh1.Range("C:C"), Sh1.Range("A:A"), _
    Sh2.Cells(2, j), Sh1.Range("B:B"), Sh2.Range("A" & i))
    Else
    Cells(i, j).Value = Application.WorksheetFunction.CountIfs(Sh1.Range("A:A"), Sh2.Cells(2, j), _
    Sh1.Range("B:B"), Sh2.Range("A" & i))
    End If
    Next j
 Next i
End Sub

This works thanks

The only issue is that it places the week#, "count" & "sum" and part number in worksheet cumlative_A but, it places the actual sum of durationan and count into whatever worksheet you are currently in. How would I fix this?

maabadi · Sep 8, 2021

BigMillBoy said:
The only issue is that it places the week#, "count" & "sum" and part number in worksheet cumlative_A but, it places the actual sum of durationan and count into whatever worksheet you are currently in. How would I fix this?

Are You want Data and Result at same Sheet?
if Yes, You want Result at where? (Which Sheet & Columns)?

VBA Code to display calculated data every second column with count in between

BigMillBoy

New Member

Excel Facts

maabadi

Well-known Member

maabadi

Well-known Member

BigMillBoy

New Member

maabadi

Well-known Member

BigMillBoy

New Member

maabadi

Well-known Member

Similar threads

Forum statistics

Share this page

VBA Code to display calculated data every second column with count in between

BigMillBoy

New Member

Excel Facts

maabadi

Well-known Member

maabadi

Well-known Member

BigMillBoy

New Member

maabadi

Well-known Member

BigMillBoy

New Member

maabadi

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock