# If statement not respected in embedded For loops

#### Mart10

##### New Member
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 :

Code:
``````Sub Caro2()

With Application
.ScreenUpdating = False
myCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = 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
.Calculation = myCalc
End With

End Sub``````

### Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

#### RalphA

##### Well-known Member
I have not tried to follow or test your code. However, In all the BASIC language programs that I know of, including the IF() function in Excel, you are permitted only seven embedded IF statements, that is, eight total, if one includes the first IF. That may be your problem.

One solution around this problem is to limit your nested IFs to the maximum, using the last IF to report a blank. Then, concatenate a new batch of nested IFs, again with the last one giving a blank, to the previous one.

An example of this, for a formula that looks at 12 possibilites, and displays a blank if none of the possiblities pans out, is:
IF(A1=1,1,IF(A1=2,2,IF(A1=3,3,IF(A1-4,4,IF(A1=5,5,IF(A1=6,6,IF(A1=7,7,IF A1=8,8,"")))))))) & IF(A1=9,9,IF(A1-10,10,IF(A1=11,11,IF(A1=12,12,""))))

For coding, after you do the first eight, and then, the last four, you would concatenate the two results.

Let us know if this alloed you to correct your code and solve your problem.

Replies
3
Views
227
Replies
0
Views
115
Replies
8
Views
267
Replies
14
Views
267
Replies
4
Views
271

### Forum statistics

1,171,062
Messages
5,873,556
Members
432,984
Latest member
WilMel ### 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.

### Which adblocker are you using?    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

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