Hi,
I would really appreciate if someone could help me with my macro
Thank you!
CONTEXT:
I am trying to build a VBA macro that would help me look at all the possible combination of weighting factors and evaluate the resulting weighted sum (also based on different set of parameters, specified by the user).
In order to do that, the resulting macro consist in :
(x Weighting factors; variables)
(AC, GW, … given parameters…I have one set per column in the spreadsheet)
1) 3 preliminary loops that are reading the data in the spreadsheet
2) 11 embedded loop that are generating all the possible weighting combination (e.g. if I have xac (0 or 1), xeu (0 or 1) and xhs (0 or 1), it would give me 8 possible combinations…with only 3 valid combinaisons since the sum of the weighting factor needs to be 1.
3) Within the 11th loop, it does the following:
a. Ensure that the sum if the weighting factor is 1
b. Calculate the weighted sum using the weighting factors and the given parameter (one set of parameters per “column in the spreadsheet”)
c. Find out which column as the smallest weighted sum
d. Add 1 to a counter specific for each column (ArrayHits()), each time the sum of a column is equal to the smallest sum (i.e. columns that are equal will all be counted)
4) 1 last loop to put the results back in the spreadsheet
PROBLEM:
The problem is that I have the following % for the given parameters (see below). If I have the same number of “1” in each column…I should have % = 100, 100, 100 !? After looking at it more closely, I realize that sometimes (I do not know why…) the if statement in steps 3c and 3d are not working properly when SumW_XYZ(e) = 1.
AvgSum 0.5 0.5 0.5
% 42.30769231 69.23076923 69.23076923
AC 0 1 1
GW 1 0 1
EU 0 1 1
OD 1 0 0
PS 0 1 0
HP 1 0 0
HC 0 1 0
HN 1 0 0
EC 0 1 0
LO 1 0 1
RE 0 1 1
NE 1 0 1
THE VBA CODE :
I would really appreciate if someone could help me with my macro
Thank you!
CONTEXT:
I am trying to build a VBA macro that would help me look at all the possible combination of weighting factors and evaluate the resulting weighted sum (also based on different set of parameters, specified by the user).
In order to do that, the resulting macro consist in :
(x Weighting factors; variables)
(AC, GW, … given parameters…I have one set per column in the spreadsheet)
1) 3 preliminary loops that are reading the data in the spreadsheet
2) 11 embedded loop that are generating all the possible weighting combination (e.g. if I have xac (0 or 1), xeu (0 or 1) and xhs (0 or 1), it would give me 8 possible combinations…with only 3 valid combinaisons since the sum of the weighting factor needs to be 1.
3) Within the 11th loop, it does the following:
a. Ensure that the sum if the weighting factor is 1
b. Calculate the weighted sum using the weighting factors and the given parameter (one set of parameters per “column in the spreadsheet”)
c. Find out which column as the smallest weighted sum
d. Add 1 to a counter specific for each column (ArrayHits()), each time the sum of a column is equal to the smallest sum (i.e. columns that are equal will all be counted)
4) 1 last loop to put the results back in the spreadsheet
PROBLEM:
The problem is that I have the following % for the given parameters (see below). If I have the same number of “1” in each column…I should have % = 100, 100, 100 !? After looking at it more closely, I realize that sometimes (I do not know why…) the if statement in steps 3c and 3d are not working properly when SumW_XYZ(e) = 1.
AvgSum 0.5 0.5 0.5
% 42.30769231 69.23076923 69.23076923
AC 0 1 1
GW 1 0 1
EU 0 1 1
OD 1 0 0
PS 0 1 0
HP 1 0 0
HC 0 1 0
HN 1 0 0
EC 0 1 0
LO 1 0 1
RE 0 1 1
NE 1 0 1
THE VBA CODE :
Code:
Sub Caro2()
With Application
.ScreenUpdating = False
myCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
End With
Dim a As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim j As Integer
Dim xac As Integer
Dim xgw As Integer
Dim xeu As Integer
Dim xod As Integer
Dim xps As Integer
Dim xhp As Integer
Dim xhc As Integer
Dim xhn As Integer
Dim xec As Integer
Dim xlo As Integer
Dim xre As Integer
Dim xne As Integer
Dim Total As Double
Dim Pourcentage As Double
Dim Sum As Double
Dim CountTot As Long
Dim CountInf As Long
Dim StepGiven As Long
Dim TotalGiven As Long
'Count the number of columns
c = 0
For a = 5 To 256
Cells(7, a).Select
If Selection.Interior.Color = RGB(255, 0, 0) Then
c = c + 1
End If
Next a
'MsgBox "Le nombre de colonne est: " & c
'Count the number of rows
d = 0
e = 0
For d = 7 To 100
Cells(d, 5).Select
If Selection.Interior.Color = RGB(255, 0, 0) Then
e = e + 1
End If
Next d
'MsgBox "Le nombre de rangée est: " & e
Dim Matrix As Variant
ReDim Matrix(e, c)
For j = 5 To c - 1 + 5
For i = 7 To e - 1 + 7
Matrix(i - 7, j - 5) = Cells(i, j).Value
Next i
Next j
‘ In the spreadsheet the parameters included in Matrix are :
‘for AC 0 1 1
‘for GW 1 0 1
‘for EU 0 1 1
‘for OD 1 0 0
‘for PS 0 1 0
‘for HP 1 0 0
‘for HC 0 1 0
‘for HN 1 0 0
‘for EC 0 1 0
‘for LO 1 0 1
'MsgBox "TEST : deuxième ligne, troisième colonne = " & Matrix(1, 2)
‘ In the spreadsheet the value of StepGiven is 5
StepGiven = Cells(1, 2).Value
‘ In the spreadsheet the value of StepGiven is 10
TotalGiven = Cells(1, 4).Value
Dim ArrayHits As Variant
ReDim ArrayHits(c)
Dim Egalite As Variant
ReDim Egalite(c)
Dim SumSumW_XYZ As Variant
ReDim SumSumW_XYZ(c)
Dim SumW_XYZ As Variant
ReDim SumW_XYZ(c)
'Array initialization
For j = 0 To c - 1
ArrayHits(j) = 0
SumSumW_XYZ(j) = 0
SumW_XYZ(j) = 0
Next
CountTot = 0
For xac = 0 To TotalGiven Step StepGiven
If (xac) > TotalGiven Then
Exit For
Else
For xgw = 0 To TotalGiven Step StepGiven
If (xac + xgw) > TotalGiven Then
Exit For
Else
For xeu = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu) > TotalGiven Then
Exit For
Else
For xod = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod) > TotalGiven Then
Exit For
Else
For xps = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps) > TotalGiven Then
Exit For
Else
For xhp = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps + xhp) > TotalGiven Then
Exit For
Else
For xhc = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps + xhp + xhc) > TotalGiven Then
Exit For
Else
For xhn = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps + xhp + xhc + xhn) > TotalGiven Then
Exit For
Else
For xec = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps + xhp + xhc + xhn + xec) > TotalGiven Then
Exit For
Else
For xlo = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps + xhp + xhc + xhn + xec + xlo) > TotalGiven Then
Exit For
Else
For xre = 0 To TotalGiven Step StepGiven
If (xac + xgw + xeu + xod + xps + xhp + xhc + xhn + xec + xlo + xre) > TotalGiven Then
Exit For
Else
'Calculate the last x, it is the difference because the sum must be equal to TotalGiven
xne = TotalGiven - (xac + xgw + xeu + xod + xps + xhp + xhc + xhn + xec + xlo + xre)
For e = 0 To c - 1 Step 1
SumW_XYZ(e) = 0
Next e
For j = 0 To c - 1 Step 1
SumW_XYZ(j) = (Matrix(0, j) * xac / TotalGiven) + (Matrix(1, j) * xgw / TotalGiven) + (Matrix(2, j) * xeu / TotalGiven) + (Matrix(3, j) * xod / TotalGiven) + (Matrix(4, j) * xps / TotalGiven) + (Matrix(5, j) * xhp / TotalGiven) + (Matrix(6, j) * xhc / TotalGiven) + (Matrix(7, j) * xhn / TotalGiven) + (Matrix(8, j) * xec / TotalGiven) + (Matrix(9, j) * xlo / TotalGiven) + (Matrix(10, j) * xre / TotalGiven) + (Matrix(11, j) * xne / TotalGiven)
SumSumW_XYZ(j) = SumSumW_XYZ(j) + SumW_XYZ(j)
Next j
'Find out what is the smallest Sum across the column calculated
Sum = 0
For e = 1 To c - 1 Step 1
If (SumW_XYZ(e) = SumW_XYZ(e - 1)) Or (SumW_XYZ(e) < SumW_XYZ(e - 1)) Then
Sum = SumW_XYZ(e)
End If
Next e
'If the sum is of a column is equal to the smallest...add one hit!
For e = 0 To c - 1 Step 1
If SumW_XYZ(e) = Sum Then
ArrayHits(e) = ArrayHits(e) + 1
End If
Next e
CountTot = CountTot + 1
End If
Next xre
End If
Next xlo
End If
Next xec
End If
Next xhn
End If
Next xhc
End If
Next xhp
End If
Next xps
End If
Next xod
End If
Next xeu
End If
Next xgw
End If
Next xac
'Put the results back in the spreadsheet
For j = 5 To c - 1 + 5
Cells(4, j).Value = SumSumW_XYZ(j - 5) / CountTot
Cells(5, j).Value = 100 * (ArrayHits(j - 5) / CountTot)
Total = Total + ArrayHits(j - 5)
If j = c - 1 + 5 Then
Cells(5, j + 1).Value = 100 * (Total / CountTot)
'Cells(4, j + 1).Value = "Sum"
End If
Next j
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = myCalc
End With
End Sub
