Re calculation of weights

E

erdem_ustun

New Member
Joined
Jun 19, 2018
Messages
12
Hi,

I have excel files.

There are different sections in this file.

There are different features under each section.
Unequal weights are available for these features.
The sum of each section is 10.
However, if there are no features under a section, the weight of the non-features needs to be proportionally distributed to other features existing under the same section.
How can I do this with VBA.
First I set all the features and weights by default. Later, if the cell were written "No" in the column next to the no features, I thought it would be necessary to re-distribute the weight in this section.

But I could not .

As sample data

[TABLE="width: 500"]
<tbody>[TR]
[TD]Nbr[/TD]
[TD]Section 1[/TD]
[TD]Default weights[/TD]
[TD]Status[/TD]
[TD]Reweighted[/TD]
[/TR]
[TR]
[TD]1.1[/TD]
[TD]Feature 1[/TD]
[TD]3[/TD]
[TD][/TD]
[TD]3,75[/TD]
[/TR]
[TR]
[TD]1.2[/TD]
[TD]Feature 2[/TD]
[TD]5[/TD]
[TD][/TD]
[TD]6,25[/TD]
[/TR]
[TR]
[TD]1.3[/TD]
[TD]Feature 3[/TD]
[TD]2[/TD]
[TD]No[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Section 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2.1[/TD]
[TD]Feature 1[/TD]
[TD]5[/TD]
[TD][/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]2.2[/TD]
[TD]Feature 2[/TD]
[TD]5[/TD]
[TD][/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Section 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3.1[/TD]
[TD]Feature 1[/TD]
[TD]2[/TD]
[TD]No[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3.2[/TD]
[TD]Feature 2[/TD]
[TD]2[/TD]
[TD][/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]3.3[/TD]
[TD]Feature 3[/TD]
[TD]2[/TD]
[TD]No[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3.4[/TD]
[TD]Feature 4[/TD]
[TD]4[/TD]
[TD]No[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]...

[/TD]
[TD].....[/TD]
[TD].....[/TD]
[TD]....[/TD]
[TD]....[/TD]
[/TR]
</tbody>[/TABLE]


I would like your help in this regard.
 
Sort by date Sort by votes

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
wideboydixon said:
If you need a reference to the original weightings then you're back to the first solution I think.

WBD
Click to expand...

I agree with your thoughts.

I think it would be more effective to keep the original references in an array and process them.

Like as

Code: 
Dim  Default_weight(9, 1) As Variant
Default_weight(1, 0) = 1.1
Default_weight(1, 1) = 0.4
Default_weight(2, 0) = 1.2
Default_weight(2, 1) = 0.5
Default_weight(3, 0) = 1.3
Default_weight(3, 1) = 0.1
Default_weight(4, 0) = 2.1
Default_weight(4, 1) = 0.5
Default_weight(5, 0) = 2.2
Default_weight(5, 1) = 0.5
Default_weight(6, 0) = 3.1
Default_weight(6, 1) = 0.2
Default_weight(7, 0) = 3.2
Default_weight(7, 1) = 0.2
Default_weight(8, 0) = 3.3
Default_weight(8, 1) = 0.2
Default_weight(9, 0) = 3.4
Default_weight(9, 1) = 0.4
 
Last edited:
Upvote 0
hi wideboydixon,

Thank you very much for the idea you have and for the code you have written.
I changed the code you wrote a bit.For the last I want to do.

But since I do not want to make mistakes, I have a request from you for the code to work effectively and quickly.


If you have the chance to check it, I'm very happy.
Code: 
Sub ReweightFeatures_V3()
Dim Default_weight(11, 1) As Variant
Dim i As Integer
Dim lastRow As Long
Dim thisRow As Long
Dim firstRow As Long
Dim weightTotal As Double


Default_weight(1, 0) = "1.1"
Default_weight(1, 1) = 3
Default_weight(2, 0) = "1.2"
Default_weight(2, 1) = 3
Default_weight(3, 0) = "1.3"
Default_weight(3, 1) = 4
Default_weight(6, 0) = "2.1"
Default_weight(6, 1) = 5
Default_weight(7, 0) = "2.2"
Default_weight(7, 1) = 5
Default_weight(8, 0) = "3.1"
Default_weight(8, 1) = 3
Default_weight(9, 0) = "3.2"
Default_weight(9, 1) = 3
Default_weight(10, 0) = "3.3"
Default_weight(10, 1) = 2
Default_weight(11, 0) = "3.4"
Default_weight(11, 1) = 2


lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
firstRow = 0
weightTotal = 0
For thisRow = 3 To lastRow
    If Cells(thisRow, 1) = "" Then
        ProcessSection firstRow, thisRow - 1, weightTotal
        firstRow = 0
        weightTotal = 0
    Else
        If firstRow = 0 Then firstRow = thisRow

[/COLOR][COLOR=#49644E]If Cells(thisRow, "C").Value <> "No" Then thisRow = thisRow  
[/COLOR][COLOR=#49644E]
       
        For i = 1 To UBound(Default_weight)
        
            If Cells(thisRow, 1) = Default_weight(i, 0) And Cells(thisRow, "C").Value <> "No" Then
                
                Cells(thisRow, "C").Value = Default_weight(i, 1)
                weightTotal = weightTotal + Cells(thisRow, "C").Value
                Exit For
            End If
        Next i
        
        
    End If
Next thisRow


End Sub[/COLOR][COLOR=#49644E]


Code: 
Private Sub ProcessSection(firstRow As Long, lastRow As Long, weightTotal As Double)


Dim thisRow As Long


For thisRow = firstRow To lastRow
    If Cells(thisRow, "C").Value <> "No" Then
        Cells(thisRow, "C").Value = Cells(thisRow, "C").Value / weightTotal * 10
    End If
Next thisRow


End Sub

[/COLOR]


Best wishes
 
Last edited:
Upvote 0
Despite its normal appearance in the editor, it appears to be sent in pieces.
Sorry.

hi wideboydixon,


Thank you very much for the idea you have and for the code you have written.
I changed the code you wrote a bit.For the last I want to do.


But since I do not want to make mistakes, I have a request from you for the code to work effectively and quickly.




If you have the chance to check it, I'm very happy.
Code: 
Sub ReweightFeatures_V3()
Dim Default_weight(11, 1) As Variant
Dim i As Integer
Dim lastRow As Long
Dim thisRow As Long
Dim firstRow As Long
Dim weightTotal As Double




Default_weight(1, 0) = "1.1"
Default_weight(1, 1) = 3
Default_weight(2, 0) = "1.2"
Default_weight(2, 1) = 3
Default_weight(3, 0) = "1.3"
Default_weight(3, 1) = 4
Default_weight(6, 0) = "2.1"
Default_weight(6, 1) = 5
Default_weight(7, 0) = "2.2"
Default_weight(7, 1) = 5
Default_weight(8, 0) = "3.1"
Default_weight(8, 1) = 3
Default_weight(9, 0) = "3.2"
Default_weight(9, 1) = 3
Default_weight(10, 0) = "3.3"
Default_weight(10, 1) = 2
Default_weight(11, 0) = "3.4"
Default_weight(11, 1) = 2


lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
firstRow = 0
weightTotal = 0
For thisRow = 3 To lastRow
    If Cells(thisRow, 1) = "" Then
        ProcessSection firstRow, thisRow - 1, weightTotal
        firstRow = 0
        weightTotal = 0
    Else
        If firstRow = 0 Then firstRow = thisRow


If Cells(thisRow, "C").Value <> "No" Then thisRow = thisRow


      
        For i = 1 To UBound(Default_weight)
        
            If Cells(thisRow, 1) = Default_weight(i, 0) And Cells(thisRow, "C").Value <> "No" Then
                
                Cells(thisRow, "C").Value = Default_weight(i, 1)
                weightTotal = weightTotal + Cells(thisRow, "C").Value
                Exit For
            End If
        Next i
        
        
    End If
Next thisRow
End Sub




Code: 
Private Sub ProcessSection(firstRow As Long, lastRow As Long, weightTotal As Double)




Dim thisRow As Long




For thisRow = firstRow To lastRow
    If Cells(thisRow, "C").Value <> "No" Then
        Cells(thisRow, "C").Value = Cells(thisRow, "C").Value / weightTotal * 10
    End If
Next thisRow




End Sub


Best wishes
 
Last edited:
Upvote 0

Book1
ABC
1NbrSectionsWeights
2Section 1
31.1Feature 1
41.2Feature 2
51.3Feature 3No
6Section 2
72.1Feature 1
82.2Feature 2
9Section 3
103.1Feature 1No
113.2Feature 2
123.3Feature 3No
133.4Feature 4No
Sheet1


Code: 
Dim defaultWeights As Variant
Public Sub ReweightFeatures()

Dim lastRow As Long
Dim thisRow As Long
Dim firstRow As Long
Dim weightTotal As Double

defaultWeights = Split("3,5,2,,5,5,,2,2,2,4", ",")

lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
firstRow = 0
weightTotal = 0
For thisRow = 3 To lastRow
    If Cells(thisRow, 1) = "" Then
        ProcessSection firstRow, thisRow - 1, weightTotal
        firstRow = 0
        weightTotal = 0
    Else
        If firstRow = 0 Then firstRow = thisRow
        If Cells(thisRow, "C").Value <> "No" Then weightTotal = weightTotal + CDbl(defaultWeights(thisRow - 3))
    End If
Next thisRow

End Sub
Private Sub ProcessSection(firstRow As Long, lastRow As Long, weightTotal As Double)

Dim thisRow As Long

For thisRow = firstRow To lastRow
    If Cells(thisRow, "C").Value <> "No" Then
        Cells(thisRow, "C").Value = CDbl(defaultWeights(thisRow - 3)) / weightTotal * 10
    End If
Next thisRow

End Sub


Book1
ABC
1NbrSectionsWeights
2Section 1
31.1Feature 13.75
41.2Feature 26.25
51.3Feature 3No
6Section 2
72.1Feature 15
82.2Feature 25
9Section 3
103.1Feature 1No
113.2Feature 210
123.3Feature 3No
133.4Feature 4No
Sheet1


WBD
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

N
  • Solved
Averaging every Nth cell in a column
Replies
9
Views
112
Peter_SSs
Peter_SSs
agerrard
  • Question Question
How to find the weighted average of a category?
Replies
1
Views
598
bebo021999
B
D
  • Solved
how to macro to auto sub-total and grand total of manpower plan used in the project
Replies
1
Views
270
david2005wang
D
C
  • Solved
Create Function that Calculates a Value Relative to Original Price and Also Constructs a Price Ladder
2
Replies
10
Views
1K
NdNoviceHlp
NdNoviceHlp
S
  • Question Question
Auto-Populate Project Status
Replies
0
Views
548
Seoham
S

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

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