to array or not? (summing up same category in range)

airforceone

Board Regular
Joined
Feb 14, 2022
Messages
201
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
It's been 2 weeks now since I started a mini project but my clogged brain won't cooperate with me :)
I hate to burden but can anyone help me, given the sample data I would like to merge all Med Category and its corresponding grams and value (number of Med per Unique Numbers Varies)
I hope I explained it clearly

Online File.xlsx
ABCDEFGHIJKLMNOP
1UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
2A0001PHA 12016.01.20OTCVIT - A15
3A0002PHA 22016.03.18NON-TAKERSVIT - B15VIT - E315
4A0003PHA 32016.04.19OTCVIT - C210VIT - C420VIT - C15
5A0004PHA 42016.04.22SIGNEDVIT - D315VIT - D525VIT - D15VIT - C15
6A0005PHA 52016.05.25NON-TAKERSVIT - D420VIT - E630VIT - E210
7A0006PHA 62016.06.23OTCVIT - E525
8
9
10EXPECTED OUTPUT
11UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
12A0001PHA 12016.01.20OTCVIT - A15
13A0002PHA 22016.03.18NON-TAKERSVIT - B15VIT - E315
14A0003PHA 32016.04.19OTCVIT - C735
15A0004PHA 42016.04.22SIGNEDVIT - D945VIT - C15
16A0005PHA 52016.05.25NON-TAKERSVIT - D420VIT - E840
17A0006PHA 62016.06.23OTCVIT - E525
VITs
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
With Excel 2016 & 2019 in your hand, this is the best solution I could think of. Though if I would need the same, I would do & look for some more refinements. But for you to understand, initially, what is being done, I kept it as simple as possible.

Check this out -

All Records.xlsb
ABCDEFGHIJKLMNOPQRS
1UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
2A0001PHA 142389OTCVIT - A15
3A0002PHA 242447NON-TAKERSVIT - B15VIT - E315
4A0003PHA 342479OTCVIT - C210VIT - C420VIT - C15
5A0004PHA 442482SIGNEDVIT - D315VIT - D525VIT - D15VIT - C15
6A0005PHA 542515NON-TAKERSVIT - D420VIT - E630VIT - E210
7A0006PHA 642544OTCVIT - E525
8
9EXPECTED OUTPUT
10UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
11A0001PHA 142389OTCVIT - A15
12A0002PHA 242447NON-TAKERSVIT - B15VIT - E315
13A0003PHA 342479OTCVIT - C735
14A0004PHA 442482SIGNEDVIT - D945VIT - C15
15A0005PHA 542515NON-TAKERSVIT - D420VIT - E840
16A0006PHA 642544OTCVIT - E525
17
18
19My Solution
20UNIQUE NUMBERUNDERDATECLASSVIT - AGramsValueVIT - BGramsValueVIT - CGramsValueVIT - DGramsValueVIT - EGramsValue
21A0001PHA 142389OTCVIT - A15VIT - B00VIT - C00VIT - D00VIT - E00
22A0002PHA 242447NON-TAKERSVIT - A00VIT - B15VIT - C00VIT - D00VIT - E315
23A0003PHA 342479OTCVIT - A00VIT - B00VIT - C735VIT - D00VIT - E00
24A0004PHA 442482SIGNEDVIT - A00VIT - B00VIT - C15VIT - D945VIT - E00
25A0005PHA 542515NON-TAKERSVIT - A00VIT - B00VIT - C00VIT - D420VIT - E840
26A0006PHA 642544OTCVIT - A00VIT - B00VIT - C00VIT - D00VIT - E525
Sheet4
Cell Formulas
RangeFormula
E21:E26,H21:H26,K21:K26,N21:N26,Q21:Q26E21=E$20
F21:F26,I21:I26,L21:L26,O21:O26,R21:R26F21=SUMIFS($F$2:$F$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($I$2:$I$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($L$2:$L$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($O$2:$O$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21)
G21:G26,J21:J26,M21:M26,P21:P26,S21:S26G21=SUMIFS($G$2:$G$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($J$2:$J$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($M$2:$M$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($P$2:$P$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21)
 
Upvote 0
This is from where I would have started and then started thinking of making my Formula(e) shorter and Summary report look bit more effective.

Still it can be a good starting point for you. Also, check the thread just prior to it.

All Records.xlsb
ABCDEFGHIJKLMNOPQRS
1UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
2A0001PHA 142389OTCVIT - A15
3A0002PHA 242447NON-TAKERSVIT - B15VIT - E315
4A0003PHA 342479OTCVIT - C210VIT - C420VIT - C15
5A0004PHA 442482SIGNEDVIT - D315VIT - D525VIT - D15VIT - C15
6A0005PHA 542515NON-TAKERSVIT - D420VIT - E630VIT - E210
7A0006PHA 642544OTCVIT - E525
8
9EXPECTED OUTPUT
10UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
11A0001PHA 142389OTCVIT - A15
12A0002PHA 242447NON-TAKERSVIT - B15VIT - E315
13A0003PHA 342479OTCVIT - C735
14A0004PHA 442482SIGNEDVIT - D945VIT - C15
15A0005PHA 542515NON-TAKERSVIT - D420VIT - E840
16A0006PHA 642544OTCVIT - E525
17
18
19My Solution
20UNIQUE NUMBERUNDERDATECLASSVIT - AGramsValueVIT - BGramsValueVIT - CGramsValueVIT - DGramsValueVIT - EGramsValue
21A0001PHA 142389OTCVIT - A15VIT - B  VIT - C  VIT - D  VIT - E  
22A0002PHA 242447NON-TAKERSVIT - A  VIT - B15VIT - C  VIT - D  VIT - E315
23A0003PHA 342479OTCVIT - A  VIT - B  VIT - C735VIT - D  VIT - E  
24A0004PHA 442482SIGNEDVIT - A  VIT - B  VIT - C15VIT - D945VIT - E  
25A0005PHA 542515NON-TAKERSVIT - A  VIT - B  VIT - C  VIT - D420VIT - E840
26A0006PHA 642544OTCVIT - A  VIT - B  VIT - C  VIT - D  VIT - E525
Sheet4
Cell Formulas
RangeFormula
E21:E26,H21:H26,K21:K26,N21:N26,Q21:Q26E21=E$20
F21:F26,I21:I26,L21:L26,O21:O26,R21:R26F21=IF((SUMIFS($F$2:$F$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($I$2:$I$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($L$2:$L$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($O$2:$O$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21))=0,"", (SUMIFS($F$2:$F$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($I$2:$I$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($L$2:$L$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($O$2:$O$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21)))
G21:G26,J21:J26,M21:M26,P21:P26,S21:S26G21=IF((SUMIFS($G$2:$G$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($J$2:$J$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($M$2:$M$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($P$2:$P$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21))=0,"", (SUMIFS($G$2:$G$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($J$2:$J$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($M$2:$M$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($P$2:$P$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21)))
 
Upvote 0
Hi,
If it's allowed a VBA solution, try this.
To make it simple, I have tried to put the procedure into a code as it would be if it were done manually.

VBA Code:
Sub Sample1()
    Dim x As Long, i As Long, a
    a = Array(5, 8, 11, 14)    'Columns for MED
    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = UBound(a) To LBound(a) + 1 Step -1
            If Cells(x, a(i)).Value <> "" Then                 
                If Cells(x, a(i)).Value = Cells(x, a(i - 1)).Value Then 'If MED is the same   
                    Cells(x, a(i)).Resize(, 3).Copy
                    Cells(x, a(i - 1)).PasteSpecial Operation:=xlAdd
                    Cells(x, a(i)).Resize(, 3).ClearContents
                    If Cells(x, a(i) + 3).Value <> "" Then
                        Cells(x, a(i) + 3).Resize(, 3).Cut Cells(x, a(i))
                    End If
                    If i = LBound(a) + 1 Then Exit For
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "done"
End Sub
 
Upvote 0
With Excel 2016 & 2019 in your hand, this is the best solution I could think of. Though if I would need the same, I would do & look for some more refinements. But for you to understand, initially, what is being done, I kept it as simple as possible.

Check this out -

All Records.xlsb
ABCDEFGHIJKLMNOPQRS
1UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
2A0001PHA 142389OTCVIT - A15
3A0002PHA 242447NON-TAKERSVIT - B15VIT - E315
4A0003PHA 342479OTCVIT - C210VIT - C420VIT - C15
5A0004PHA 442482SIGNEDVIT - D315VIT - D525VIT - D15VIT - C15
6A0005PHA 542515NON-TAKERSVIT - D420VIT - E630VIT - E210
7A0006PHA 642544OTCVIT - E525
8
9EXPECTED OUTPUT
10UNIQUE NUMBERUNDERDATECLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
11A0001PHA 142389OTCVIT - A15
12A0002PHA 242447NON-TAKERSVIT - B15VIT - E315
13A0003PHA 342479OTCVIT - C735
14A0004PHA 442482SIGNEDVIT - D945VIT - C15
15A0005PHA 542515NON-TAKERSVIT - D420VIT - E840
16A0006PHA 642544OTCVIT - E525
17
18
19My Solution
20UNIQUE NUMBERUNDERDATECLASSVIT - AGramsValueVIT - BGramsValueVIT - CGramsValueVIT - DGramsValueVIT - EGramsValue
21A0001PHA 142389OTCVIT - A15VIT - B00VIT - C00VIT - D00VIT - E00
22A0002PHA 242447NON-TAKERSVIT - A00VIT - B15VIT - C00VIT - D00VIT - E315
23A0003PHA 342479OTCVIT - A00VIT - B00VIT - C735VIT - D00VIT - E00
24A0004PHA 442482SIGNEDVIT - A00VIT - B00VIT - C15VIT - D945VIT - E00
25A0005PHA 542515NON-TAKERSVIT - A00VIT - B00VIT - C00VIT - D420VIT - E840
26A0006PHA 642544OTCVIT - A00VIT - B00VIT - C00VIT - D00VIT - E525
Sheet4
Cell Formulas
RangeFormula
E21:E26,H21:H26,K21:K26,N21:N26,Q21:Q26E21=E$20
F21:F26,I21:I26,L21:L26,O21:O26,R21:R26F21=SUMIFS($F$2:$F$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($I$2:$I$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($L$2:$L$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($O$2:$O$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21)
G21:G26,J21:J26,M21:M26,P21:P26,S21:S26G21=SUMIFS($G$2:$G$7,$A$2:$A$7,$A21,$E$2:$E$7,E21,$C$2:$C$7,$C21)+SUMIFS($J$2:$J$7,$A$2:$A$7,$A21,$H$2:$H$7,E21,$C$2:$C$7,$C21) +SUMIFS($M$2:$M$7,$A$2:$A$7,$A21,$K$2:$K$7,E21,$C$2:$C$7,$C21)+SUMIFS($P$2:$P$7,$A$2:$A$7,$A21,$N$2:$N$7,E21,$C$2:$C$7,$C21)
thank you for the quick reply, anyway I forgot to mention that I needed it on VBA code :)
 
Upvote 0
Hi,
If it's allowed a VBA solution, try this.
To make it simple, I have tried to put the procedure into a code as it would be if it were done manually.

VBA Code:
Sub Sample1()
    Dim x As Long, i As Long, a
    a = Array(5, 8, 11, 14)    'Columns for MED
    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = UBound(a) To LBound(a) + 1 Step -1
            If Cells(x, a(i)).Value <> "" Then                
                If Cells(x, a(i)).Value = Cells(x, a(i - 1)).Value Then 'If MED is the same  
                    Cells(x, a(i)).Resize(, 3).Copy
                    Cells(x, a(i - 1)).PasteSpecial Operation:=xlAdd
                    Cells(x, a(i)).Resize(, 3).ClearContents
                    If Cells(x, a(i) + 3).Value <> "" Then
                        Cells(x, a(i) + 3).Resize(, 3).Cut Cells(x, a(i))
                    End If
                    If i = LBound(a) + 1 Then Exit For
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "done"
End Sub
works like a charm on my sample data, will incorporate it later to the main data. will keep you posted. but thanks mate...
 
Upvote 0
Hi,
If it's allowed a VBA solution, try this.
To make it simple, I have tried to put the procedure into a code as it would be if it were done manually.

VBA Code:
Sub Sample1()
    Dim x As Long, i As Long, a
    a = Array(5, 8, 11, 14)    'Columns for MED
    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = UBound(a) To LBound(a) + 1 Step -1
            If Cells(x, a(i)).Value <> "" Then                
                If Cells(x, a(i)).Value = Cells(x, a(i - 1)).Value Then 'If MED is the same  
                    Cells(x, a(i)).Resize(, 3).Copy
                    Cells(x, a(i - 1)).PasteSpecial Operation:=xlAdd
                    Cells(x, a(i)).Resize(, 3).ClearContents
                    If Cells(x, a(i) + 3).Value <> "" Then
                        Cells(x, a(i) + 3).Resize(, 3).Cut Cells(x, a(i))
                    End If
                    If i = LBound(a) + 1 Then Exit For
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "done"
End Sub
is there anyway to make the columns head (count) dynamic? because the number of Med may differ, having it hardcoded might be a problem in the future...
 
Upvote 0
is there anyway to make the columns head (count) dynamic?
Sure. Just a simple calculation makes it possible.

VBA Code:
Sub Sample2()
    Dim x As Long, y As Long, i As Long, a

    'Header
    y = Cells(1, Columns.Count).End(xlToLeft).Column
    ReDim a((y - 4) / 3 - 1)
    For i = 5 To y Step 3
        a(x) = i
        x = x + 1
    Next

    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = UBound(a) To LBound(a) + 1 Step -1
            If Cells(x, a(i)).Value <> "" Then
                If Cells(x, a(i)).Value = Cells(x, a(i - 1)).Value Then    'If MED is the same
                    Cells(x, a(i)).Resize(, 3).Copy
                    Cells(x, a(i - 1)).PasteSpecial Operation:=xlAdd
                    Cells(x, a(i)).Resize(, 3).ClearContents
                    If Cells(x, a(i) + 3).Value <> "" Then
                        Cells(x, a(i) + 3).Resize(, 3).Cut Cells(x, a(i))
                    End If
                    If i = LBound(a) + 1 Then Exit For
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "done"
End Sub
 
Upvote 0
Sure. Just a simple calculation makes it possible.

VBA Code:
Sub Sample2()
    Dim x As Long, y As Long, i As Long, a

    'Header
    y = Cells(1, Columns.Count).End(xlToLeft).Column
    ReDim a((y - 4) / 3 - 1)
    For i = 5 To y Step 3
        a(x) = i
        x = x + 1
    Next

    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = UBound(a) To LBound(a) + 1 Step -1
            If Cells(x, a(i)).Value <> "" Then
                If Cells(x, a(i)).Value = Cells(x, a(i - 1)).Value Then    'If MED is the same
                    Cells(x, a(i)).Resize(, 3).Copy
                    Cells(x, a(i - 1)).PasteSpecial Operation:=xlAdd
                    Cells(x, a(i)).Resize(, 3).ClearContents
                    If Cells(x, a(i) + 3).Value <> "" Then
                        Cells(x, a(i) + 3).Resize(, 3).Cut Cells(x, a(i))
                    End If
                    If i = LBound(a) + 1 Then Exit For
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "done"
End Sub
trying it out now... will post result...
 
Upvote 0
Sure. Just a simple calculation makes it possible.

VBA Code:
Sub Sample2()
    Dim x As Long, y As Long, i As Long, a

    'Header
    y = Cells(1, Columns.Count).End(xlToLeft).Column
    ReDim a((y - 4) / 3 - 1)
    For i = 5 To y Step 3
        a(x) = i
        x = x + 1
    Next

    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = UBound(a) To LBound(a) + 1 Step -1
            If Cells(x, a(i)).Value <> "" Then
                If Cells(x, a(i)).Value = Cells(x, a(i - 1)).Value Then    'If MED is the same
                    Cells(x, a(i)).Resize(, 3).Copy
                    Cells(x, a(i - 1)).PasteSpecial Operation:=xlAdd
                    Cells(x, a(i)).Resize(, 3).ClearContents
                    If Cells(x, a(i) + 3).Value <> "" Then
                        Cells(x, a(i) + 3).Resize(, 3).Cut Cells(x, a(i))
                    End If
                    If i = LBound(a) + 1 Then Exit For
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "done"
End Sub
on the given data it works like a charm but when I add a few more Vits it doesn't seem to compute anymore hmmm strange.... any idea? below is the new sample data
Online File.xlsx
DEFGHIJKLMNOPQRSTUV
1CLASSMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValueMEDGramsValue
2OTCVIT - A15
3NON-TAKERSVIT - B15VIT - E315
4OTCVIT - C210VIT - C420VIT - C15VIT - C15VIT - C15
5SIGNEDVIT - D315VIT - D525VIT - D15VIT - C15VIT - D15VIT - C15
6NON-TAKERSVIT - D420VIT - E630VIT - E210VIT - C15VIT - E210
7OTCVIT - E525
VITs (15)
 
Upvote 0

Forum statistics

Threads
1,223,246
Messages
6,170,988
Members
452,373
Latest member
TimReeks

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