If statement not respected in embedded For loops

Mart10

New Member
Joined
Sep 24, 2006
Messages
1
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
      .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
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

RalphA

Well-known Member
Joined
May 14, 2003
Messages
3,829
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.
 

Forum statistics

Threads
1,136,616
Messages
5,676,838
Members
419,653
Latest member
analyticalchemist94

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
Top