The fastest way to Distribute new Values in Table

So you're asking that 10 be divided among the remaining rows (with the filters you quoted, there are 3 rows) based on their relevant weights (Col G) and added to what is already in Col K (April 2016)?

Sorry, but I am very confused now. How did you get these numbers?
As I can see in cell H3087 is 2488. So =2488+10(from L3087)= 2498 and you have 2501?
The SUM for L3087+L4866+L4892 is 12 401??

I downloaded your file and in Column H I have % Values, is this correct?
How did you create this formula?

Sorry again, but I can't catch you.

P.S. I am not able to copy the formula from step 1. Where I need to put it?

Okay, using this example, it would be
10+10000*0.97%/3.91%
3.91 is the sum of the unfiltered weighted values

Here's my suggestion,
Step 1. Insert a column before the dates, For the header, use 1 as a placeholder
=Table_NAMER11[[#Headers],[10.00]]*[@[Rel Weight]]/SUBTOTAL(9,[Rel Weight]) Format Col H as Number with 0 decimals

Step 2
Filter what you need to filter, place the value you want into header H (change 1 to 10000)
You shoulld get 3 rows that add up to 10000 (with negligible differences due to rounding)

Step 3
Copy these three cells and select the cells in L (Apr -16)
Paste Special > Select "Add" AND "Values" Hit "OK"

Done

Can you check this example for Copy--->Add

Filtered cells are the BIG problem!

Is there any solution for this?

Step 1 is a one tiime event. Once it's in place, it can stay there. It doesn't hurt anything.

Okay, probably messed some numbers up while experimenting. However, I do see now that if I try to copy paste ADD and VALUES at the same time, it doesn't work properly.

It does work if you just do Paste Special > Add
That adds the formula into those cells, then you need to copy>Paste Special> Values on top of itself to remove formula

Ahhhh, I see the problem. The only solution I can think of is to do that one row at a time which I think you said would not be viable. I'm thinking now that VBA will be necessary. I'll ask for some of the VBA experts to take a look.

Try this:

Sub Toci(): Dim wd As Worksheet, r As Long, P As Single
Set wd = Sheets("Data")
                    With wd.UsedRange
                    .AutoFilter
        .AutoFilter Field:=1, Criteria1:="EU"
        .AutoFilter Field:=2, Criteria1:="EU403"
        .AutoFilter Field:=3, Criteria1:="B"
        .AutoFilter Field:=4, Criteria1:="Financial"
        .AutoFilter Field:=5, Criteria1:="First"
        .AutoFilter Field:=6, Criteria1:="First3", Operator:=xlOr, Criteria2:="First13"
        
        For r = 2 To wd.UsedRange.Rows.count
        If Not Rows(r).Hidden Then
        If IsNumeric(wd.Cells(r, 7)) Then
        P = wd.Cells(r, 7)
        wd.Cells(r, 11) = wd.Cells(r, 11) + P * 10000
        End If: End If: Next r
        '.AutoFilter
        End With
End Sub

You could enter the criteria right into the already submitted code or something like this:

Sub Toci(): Dim wd As Worksheet, r As Long, P As Single, T As Single
Dim Amt As Single, C1 As String, C2 As String, C3 As String, C4 As String
            Dim C5 As String, C6a As String, C6b As String

                    Amt = 10000
                    C1 = "EU"
                    C2 = "EU403"
                    C3 = "B"
                    C4 = "Financial"
                    C5 = "First"
                    C6a = "First3"
                    C6b = "First13"


Set wd = Sheets("Data")
                    With wd.UsedRange
                    .AutoFilter
        .AutoFilter Field:=1, Criteria1:=C1
        .AutoFilter Field:=2, Criteria1:=C2
        .AutoFilter Field:=3, Criteria1:=C3
        .AutoFilter Field:=4, Criteria1:=C4
        .AutoFilter Field:=5, Criteria1:=C5
        .AutoFilter Field:=6, Criteria1:=C6a, Operator:=xlOr, Criteria2:=C6b
        T = WorksheetFunction.Subtotal(3, Range("G:G"))
        For r = 2 To wd.UsedRange.Rows.count
        If Not Rows(r).Hidden Then
        If IsNumeric(wd.Cells(r, 7)) Then
        P = wd.Cells(r, 7) ' / T
        wd.Cells(r, 11) = wd.Cells(r, 11) + P * Amt
        End If: End If: Next r
        '.AutoFilter
        End With
End Sub

Well, I've got to go to work now. How do you want the criteria? Have you a list? Are they on a worksheet? What? Where?

After the filter, the program just processes the visible rows. What would it copy the amount is calculated? Have you run macros
before?

Here's a corrected version that yields the 2498 etc.

Sub Toci(): Dim wd As Worksheet, r As Long, P As Single, T As Single
Dim Amt As Single, C1 As String, C2 As String, C3 As String, C4 As String
            Dim C5 As String, C6a As String, C6b As String
                    Amt = 10000
                    C1 = "EU"
                    C2 = "EU403"
                    C3 = "B"
                    C4 = "Financial"
                    C5 = "First"
                    C6a = "First3"
                    C6b = "First13"
Set wd = Sheets("Data")
                    With wd.UsedRange
                    .AutoFilter
        .AutoFilter Field:=1, Criteria1:=C1
        .AutoFilter Field:=2, Criteria1:=C2
        .AutoFilter Field:=3, Criteria1:=C3
        .AutoFilter Field:=4, Criteria1:=C4
        .AutoFilter Field:=5, Criteria1:=C5
        .AutoFilter Field:=6, Criteria1:=C6a, Operator:=xlOr, Criteria2:=C6b
        T = WorksheetFunction.Subtotal(9, Range("G:G"))
        For r = 2 To wd.UsedRange.Rows.count
        If Not Rows(r).Hidden Then
        If IsNumeric(wd.Cells(r, 7)) Then
        P = wd.Cells(r, 7) / T
        wd.Cells(r, 11) = wd.Cells(r, 11) + P * Amt
        End If: End If: Next r
        End With
End Sub

When I finished with filtering (Columns: A,B,C,D,E,F), in Column H, cell H1, I put some Values e.g. 10000 and get what I want below in that column. Than, I run macro and it hide all my rows which were visible after filtering ??
So, did I miss something.
And I have run a lot of macros before
Can you check this once more again?

There's no attachment on post #24

But, you're right the macro doesn't reset the filter until the next run.

Post #11 did nothing for me. Am I looking at the same thing you are?

This works:

Sub Toci(): Dim wd As Worksheet, r As Long, P As Single, T As Single
Dim Amt As Single, C1 As String, C2 As String, C3 As String, C4 As String
            Dim C5 As String, C6a As String, C6b As String
            
            Set wd = Sheets("Data")
                With wd.UsedRange
                
                Amt = .Range("H1")
                
                GoTo Filtered

                    'Amt = 10000
                    'C1 = "EU"
                    'C2 = "EU403"
                    'C3 = "B"
                    'C4 = "Financial"
                    'C5 = "First"
                    'C6a = "First3"
                    'C6b = "First13"
    
          .AutoFilter
        .AutoFilter Field:=1, Criteria1:=C1
        .AutoFilter Field:=2, Criteria1:=C2
        .AutoFilter Field:=3, Criteria1:=C3
        .AutoFilter Field:=4, Criteria1:=C4
        .AutoFilter Field:=5, Criteria1:=C5
        .AutoFilter Field:=6, Criteria1:=C6a, Operator:=xlOr, Criteria2:=C6b
Filtered:
        T = WorksheetFunction.Subtotal(9, Range("G:G"))
        For r = 2 To wd.UsedRange.Rows.Count
        If Not Rows(r).Hidden Then
        If IsNumeric(wd.Cells(r, 7)) Then
        P = wd.Cells(r, 7) / T
        wd.Cells(r, 11) = wd.Cells(r, 11) + P * Amt
        End If: End If: Next r
        End With
End Sub

You're welcome and thanks for the rep!

If you're going to manually filter the data we can eliminate a bunch of code:

Sub TociFiltered(): Dim wd As Worksheet, r As Long, P As Single, T As Single
Dim Amt As Single, Col As String, C1 As String, C2 As String, C3 As String
Dim C4 As String, C5 As String, C6a As String, C6b As String
            
            Set wd = Sheets("Data")
                With wd.UsedRange
                
                Amt = .Range("H1")
                Col = InputBox("What do the results go in to? - Type K, L, M etc")
                
                GoTo Filtered

                    'Amt = 10000
                    'C1 = "EU"
                    'C2 = "EU403"
                    'C3 = "B"
                    'C4 = "Financial"
                    'C5 = "First"
                    'C6a = "First3"
                    'C6b = "First13"
    
          .AutoFilter
        .AutoFilter Field:=1, Criteria1:=C1
        .AutoFilter Field:=2, Criteria1:=C2
        .AutoFilter Field:=3, Criteria1:=C3
        .AutoFilter Field:=4, Criteria1:=C4
        .AutoFilter Field:=5, Criteria1:=C5
        .AutoFilter Field:=6, Criteria1:=C6a, Operator:=xlOr, Criteria2:=C6b
Filtered:
        T = WorksheetFunction.Subtotal(9, Range("G:G"))
        For r = 2 To wd.UsedRange.Rows.count
        If Not Rows(r).Hidden Then
        If IsNumeric(wd.Cells(r, 7)) Then
        P = wd.Cells(r, 7) / T
        wd.Cells(r, Col) = wd.Cells(r, Col) + P * Amt
        End If: End If: Next r
        End With
End Sub

Here's code if you want to Autofilter:

Sub TociFiltered(): Dim wd As Worksheet, r As Long, P As Single, T As Single
Dim Amt As Single, Col As String, C1, C2, C3, C4, C5, C6
            
            Set wd = Sheets("Data")
                With wd.UsedRange
                
                Amt = .Range("H1")
                Col = InputBox("What do the results go in to? - Type K, L, M etc")
                
                GoTo Filtered
                    C1 = Array("EU")
                    C2 = Array("EU213", "EU116")
                    C3 = Array("B", "A")
                    C4 = Array("Financial")
                    C5 = Array("BILL")
                    C6 = Array("Bill0", "Bill10", "Bill1")
          .AutoFilter
        .AutoFilter Field:=1, Criteria1:=C1, Operator:=xlFilterValues
        .AutoFilter Field:=2, Criteria1:=C2, Operator:=xlFilterValues
        .AutoFilter Field:=3, Criteria1:=C3, Operator:=xlFilterValues
        .AutoFilter Field:=4, Criteria1:=C4, Operator:=xlFilterValues
        .AutoFilter Field:=5, Criteria1:=C5, Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:=C6, Operator:=xlFilterValues
Filtered:
        T = WorksheetFunction.Subtotal(9, Range("G:G"))
        For r = 2 To wd.UsedRange.Rows.count
        If Not Rows(r).Hidden Then
        If IsNumeric(wd.Cells(r, 7)) Then
        P = wd.Cells(r, 7) / T
        wd.Cells(r, Col) = wd.Cells(r, Col) + P * Amt
        End If: End If: Next r
        End With
End Sub

if you want to actually autofilter then just put an apostrophe before

GoTo Filtered

Hi Toci,

With this code:

Sub TociFilteredII(): Dim wd As Worksheet, r As Long, p As Single, t As Single
Dim Amt As Single, Col As String, C1, C2, C3, C4, C5, C6, X, n As Long
            
            Set wd = Sheets("Data")
                With wd.UsedRange
                
                Amt = .Range("H1")
                Col = InputBox("In what columns? If more than one Type K|L|M etc")
                X = Split(Col, "|")
                
                GoTo Filtered
                    C1 = Array("EU")
                    C2 = Array("EU213", "EU116")
                    C3 = Array("B", "A")
                    C4 = Array("Financial")
                    C5 = Array("BILL")
                    C6 = Array("Bill0", "Bill10", "Bill1")
          .AutoFilter
        .AutoFilter Field:=1, Criteria1:=C1, Operator:=xlFilterValues
        .AutoFilter Field:=2, Criteria1:=C2, Operator:=xlFilterValues
        .AutoFilter Field:=3, Criteria1:=C3, Operator:=xlFilterValues
        .AutoFilter Field:=4, Criteria1:=C4, Operator:=xlFilterValues
        .AutoFilter Field:=5, Criteria1:=C5, Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:=C6, Operator:=xlFilterValues
Filtered:
        t = WorksheetFunction.Subtotal(9, Range("G:G"))
        For r = 2 To wd.UsedRange.Rows.Count
        If Not Rows(r).Hidden Then
        If IsNumeric(.Cells(r, 7)) Then
        p = .Cells(r, 7) / t
        .Cells(r, X(0)) = .Cells(r, X(0)) + p * Amt
        If InStr(1, Col, "|") Then
        For n = 1 To UBound(X)
        .Cells(r, X(n)).Value = .Cells(r, X(n)).Value + p * Amt
        Next n
        End If
        End If: End If: Next r
        End With
End Sub

I get:Toci.PNG

You're welcome and thanks for the rep!

Hi Toci,

It worked on your sample, have you a different sample?

You're welcome!

Hi Toci,

Try this:

Sub TociTransVals(): Dim wd As Worksheet, r As Long
            Set wd = Sheets("Data")
            For r = 2 To wd.UsedRange.Rows.Count
        If Not Rows(r).Hidden Then
        wd.Cells(r, 20).Resize(1, 12).NumberFormat = "0"
        wd.Cells(r, 20).Resize(1, 12).Value = _
        wd.Cells(r, 8).Resize(1, 12).Value
        End If: Next r
End Sub

Hi Toci,

Try this:

Sub TociTransVals(): Dim wd As Worksheet, r As Long, n As Long
            Set wd = Sheets("Data")
            For r = 2 To wd.UsedRange.Rows.count
                If Not Rows(r).Hidden Then
        wd.Cells(r, 20).Resize(1, 12).NumberFormat = "0"
            For n = 20 To 31
wd.Cells(r, n).Value = wd.Cells(r, n).Value + wd.Cells(r, n - 12).Value
            Next n: End If: Next r
End Sub