Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel: Array for a lot of calculations

Status
Not open for further replies.

conceal

Technical User
Apr 1, 2007
14
NL
Hello,

The last week I've been programming on a Excel-file that should calculate the optimal combination of persons and locations. I've made a table with 5 rows and 5 coloms. In the cells is a score filled in what gives an indication of the knowlegde of the person on that location (considering the activities he has to do there). I'm searching for the optimal combination, where each person has to have 1 location. To find this, I've made a calculation (zie VBA). For this small table it's simple to program, but I would like to extand this table to a 150 by 150 table (or even bigger). This means a lot of calculations and a lot of programming if I proceed this method. I'm searching for an array that ensures me that the loop isn't getting to big. Thanks for your effort!

The VBA code for the 5 by 5 table:

Code:
‘----------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim rij%, rij1%, rij2%, rij3%, rij4%, rij5%, rijt%
Dim wp1%, wp2%, wp3%, wp4%, wp5%
Dim optie%, optie1%, optie2%

'I'm Dutch, so some variable's are in Dutch
'rij = row
'optie = option
'wp = werkplek = "location where someone works"

rij = 3
rij1 = 3
rij2 = 3
rij3 = 3
rij4 = 3
rij5 = 3
optie = 0
optie1 = 0
optie2 = 0


    While rij1 < 8
        While rij2 < 8
            If rij2 <> rij1 Then
            While rij3 < 8
                If rij3 <> rij1 Then
                If rij3 <> rij2 Then
                While rij4 < 8
                    If rij4 <> rij1 Then
                    If rij4 <> rij2 Then
                    If rij4 <> rij3 Then
                        While rij5 < 8
                        If rij5 <> rij1 Then
                        If rij5 <> rij2 Then
                        If rij5 <> rij3 Then
                        If rij5 <> rij4 Then
                        wp1 = Sheets("Sheet1").Cells(rij1, 2)
wp2 = Sheets("Sheet1").Cells(rij2, 3)
wp3 = Sheets("Sheet1").Cells(rij3, 4)
wp4 = Sheets("Sheet1").Cells(rij4, 5)
wp5 = Sheets("Sheet1").Cells(rij5, 6)
optie = wp1 * wp2 * wp3 * wp4 * wp5
optie1 = optie
                            If optie1 > optie2 Then
                            optie2 = optie1
                                Sheets("Sheet2").Select
                                Sheets("Sheet2").Range("A3:F15000").Delete
                                rij = 3
                                Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                Sheets("Sheet2").Cells(rij, 6) = optie2
                                Sheets("Sheet2").Cells(rij, 7) = wp1
                                Sheets("Sheet2").Cells(rij, 8) = wp2
                                Sheets("Sheet2").Cells(rij, 9) = wp3
                                Sheets("Sheet2").Cells(rij, 10) = wp4
                                Sheets("Sheet2").Cells(rij, 11) = wp5
                            Else
                                If optie1 = optie2 Then
                                        rij = rij + 1
                                        Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                        Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                        Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                        Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                        Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                        Sheets("Sheet2").Cells(rij, 6) = optie2
                                    End If
                            End If
                        End If
                        End If
                        End If
                        End If
                        rij5 = rij5 + 1
                        Wend
                        rij5 = 3
                    End If
                    End If
                    End If
                rij4 = rij4 + 1
                Wend
                rij4 = 3
                End If
                End If
            rij3 = rij3 + 1
            Wend
            rij3 = 3
            End If
        rij2 = rij2 + 1
        Wend
        rij2 = 3
    rij1 = rij1 + 1
    Wend

End Sub
‘--------------------------------------------------------------------------------------
The VBA-code I've now (but is not working) is:


Code:
'--------------
For i = 1 To 5
    While rij(i) < 8
        For j = 1 To i
            If rij(i) <> rij(j) Then
                        wp1 = Sheets("Sheet1").Cells(rij1, 2)
wp2 = Sheets("Sheet1").Cells(rij2, 3)
wp3 = Sheets("Sheet1").Cells(rij3, 4)
wp4 = Sheets("Sheet1").Cells(rij4, 5)
wp5 = Sheets("Sheet1").Cells(rij5, 6)
optie = wp1 * wp2 * wp3 * wp4 * wp5
optie1 = optie
                            If optie1 > optie2 Then
                            optie2 = optie1
                                Sheets("Sheet2").Select
                                Sheets("Sheet2").Range("A3:F15000").Delete
                                rij = 3
                                Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                Sheets("Sheet2").Cells(rij, 6) = optie2
                                Sheets("Sheet2").Cells(rij, 7) = wp1
                                Sheets("Sheet2").Cells(rij, 8) = wp2
                                Sheets("Sheet2").Cells(rij, 9) = wp3
                                Sheets("Sheet2").Cells(rij, 10) = wp4
                                Sheets("Sheet2").Cells(rij, 11) = wp5
                            Else
                                If optie1 = optie2 Then
                                        rij = rij + 1
                                        Sheets("Sheet2").Cells(rij, 1) = Sheets("Sheet1").Cells(rij1, 1)
                                        Sheets("Sheet2").Cells(rij, 2) = Sheets("Sheet1").Cells(rij2, 1)
                                        Sheets("Sheet2").Cells(rij, 3) = Sheets("Sheet1").Cells(rij3, 1)
                                        Sheets("Sheet2").Cells(rij, 4) = Sheets("Sheet1").Cells(rij4, 1)
                                        Sheets("Sheet2").Cells(rij, 5) = Sheets("Sheet1").Cells(rij5, 1)
                                        Sheets("Sheet2").Cells(rij, 6) = optie2
                                    End If
                            End If
            End If
        Next j
    Wend
Next i
'-----------------
 



Hi,

Since you did not give us any information regarding either the structure of the matrix or the logic in the process, the only suggestion I might offer in general is to make your row, option and location variables arrays that you could ReDim on the fly, based on the row/column count on the sheet. Then you might also be able to code a recursive procedure that would drill down into your matrix.

Both of these suggestions preclude knowing the size of the matrix and having to code accordingly.

Skip,

[glasses] [red][/red]
[tongue]
 
It might also be useful to remember that your matrix is really a spreadsheet and therefore has properties that might be beyond those of algebra. Specifically, your data are in a range. Do you know the range? Even if you don't, you can determine it programmatically if you know the density of data within it (usedrange, xlDown.end, etc), so let's say you do. Then the number of columns is range(<your range).columns.count and the number of rows is range(<your range).rows.count. So, having the dimensions of the matrix, what is it you want to do? You can march through the cells of a column without using an array: For Each c In r.Cells, where r, say, is set r = range(cells(1,4),cells(numcols,4)) for the 4th column.

_________________
Bob Rashkin
 
Hi SkipVought and Bong,

Thanks for your answers, but if posted this question at two forums (also at the Microsoft Office forum) and there they made a good point... it would take YEARS to perform these calculations... I have to find an other model to find the optimal combination. Nevertheless I would like to thank you for the answers. I think that I could use the code you've given me!

Greetings,
Maik
 
Hi Bong,

I was programming and used your recommendation 'usedrange'. When I apply this on a table of 5 by 5 and execute the program everything goes fine. But, when I change the table to a table of 3 by 3 the usedrange still is 5 by 5. Is there something I'm missing here? Should I delete or clear something??? Thanks in advance for your effort!

Greetings,
Maik
 




UsedRange retains Row & Column information until you DELETE (not just CLEAR) unused Rows/Columns AND save the workbook.

Skip,

[glasses] [red][/red]
[tongue]
 
As I said, if you know the density of the data, there are more definitive ways to determine the range of your table (matrix). If, say, column A is guaranteed to have all its rows populated, starting at row 1, you can use this:
lastRow = Cells(1, 1).End(xlDown).Row

If not, but the last cell is guaranteed to be populated, you can start from below:
lastRow = Range("a65536").End(xlUp).Row

_________________
Bob Rashkin
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top