Code loop through two tables checking and altering

**excel_lover** · 11-12-2008, 03:34 PM

Hi I have a looping code problem I was wondering if you could have a quick look for me.

I have two tables of information. The first is a matrix with some distances. The second is a table of distribution. Ive been trying this for a long time now with limited success using a truth table but i've realised the only way to do this is in code. Ive got limited experience with this so please point me in the right direction.

Ive written some steps explaining what each table does here -

Step 1 Check for lowest value B4:F4 in Table 1 (in example is 10)
Step 2 Check corresponding column destination available capacity in table 2 (Example 500)
Step 3 Distribute as much as possible from source in table 2 (500)
Step 4 Reduce value in capacity line by value taken from source
Step 5 If some source remains move back to table 1 and find next nearest column Dest
Step 6 Repeat step 2 until all source is gone in row
Step 7 Check for lowest value B5:F5 in Table 1
if run out of capacity at all sites stop code
etc
until Table 1 column B is empty

Ive posted a spreadsheet with some before and after tables in it aswell. Its very small and formatted o its easy to see whats happening.

Thanks for taking a look.

**VBA Noob** · 11-12-2008, 04:20 PM

excel_lover,

Please read fourm rules below and then add the link to you're cross post

VBA Noob

**excel_lover** · 11-12-2008, 04:59 PM

Sorry VBA Noonb - I have posted this at mrexcel too.
http://www.mrexcel.com/forum/showthread.php?t=352898

**StephenR** · 11-12-2008, 05:03 PM

This works for your example.

Sub x()

Dim rngDistance As Range, rngDistr As Range
Dim nMin As Long, nMinD As Long, r As Long, n As Long
Dim wf As WorksheetFunction

Set wf = WorksheetFunction
Set rngDistance = Range("B4:F7")
Set rngDistr = Range("B11:G15")

For r = 1 To rngDistance.Rows.Count
    Do While rngDistr(r + 1, 1) > 0
        n = n + 1
        nMin = wf.Small(rngDistance.Rows(r), n)
        nMinD = wf.Index(rngDistr, 1, 1 + wf.Match(nMin, rngDistance.Rows(r), 0))
        If nMinD <= rngDistr(r + 1, 1) Then
            rngDistr(r + 1, 1 + wf.Match(nMin, rngDistance.Rows(r), 0)) = nMinD
            rngDistr(r + 1, 1) = rngDistr(r + 1, 1) - nMinD
        ElseIf nMinD > rngDistr(r + 1, 1) Then
            rngDistr(r + 1, 1 + wf.Match(nMin, rngDistance.Rows(r), 0)) = rngDistr(r + 1, 1)
            rngDistr(r + 1, 1) = 0
        End If
    Loop
    n = 0
Next r
        
End Sub

**excel_lover** · 11-12-2008, 05:27 PM

Thanks Stephen thats brilliant. Ive tried expanding it though and get an error telling me -

"Unable to get the small property of the worksheet function class".

When I debug this it highlights the row containing

nMin = wf.Small(rngDistance.Rows(r), n)

Ive posted my alterations below with the code alteration ive made. Where have i gone wrong?

Thanks

**StephenR** · 11-12-2008, 05:35 PM

I think just change this line so that it includes the row with the distribution amounts (you had B17):

Set rngDistr = Range("B16:K22")

The code now runs, although I haven't checked that it gives the right answer!

**excel_lover** · 11-12-2008, 05:39 PM

thanks a lot stephen thats some excellent coding

Code loop through two tables checking and altering

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Code loop through two tables checking and altering

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions