Logical Error in my code

Question

I have written the code below in which I have to first identify smallest, 2nd smallest and so on numbers and then obtain the row numbers for them (I am saving the row numbers in a separate column, here column 50, in case there are more than one such number) and copy contents from one column (Here column 2) to another (Here Column 7) in the order of the row numbers, i.e. Smallest first, then 2nd smallest, and so on.

There are 172 such data sets starting at every 43 rows

This will continue till the sum of the numbers in the new column (45 row of Column 7 of each dataset) (To which the data is copied) is less than a specified number (45 row of Column 1 in every data set, i.e., A45 then A88)

EDIT: The sums being compared above, i.e. G45 is compared to A45 is through formula in the sheet itself

Dim m As Range, cl As Range, k As Double, b As Double, lIndex As Double, a As Double, multi As Double, l As Integer, x As Double

Set m = ActiveSheet.Range("E3:E40")
multi = 2                                                              'To move to starting position of the data set

For i = 1 To 172
    b = 45 + 43 * (i - 1)

    For k = 1 To 38
        a = Application.Small(m, k) 'To find the kth smallest number
        l = 1
        For j = 1 To 38             'To store the matching row numbers (Multiple instances) in column 50
                Cells(j, 50).Value = 0                                     'Initializing to column no. 50 to 0
                If Cells(j + multi, 5).Value = a Then                      'Checking for match
                    Cells(l, 50).Value = j + multi                         'Storing Row coordinates in column no. 50
                    l = l + 1
                End If
            Next j

 '==============THE FOLLOWING IS THE AREA WHERE THE PROBLEM MIGHT BE====================== 


        For o = 1 To l - 1 'To Copy the values based on the criteria
            x = Cells(o, 50).Value
            If Cells(b, 7).Value <= Cells(b, 1).Value Then             '"CRITERIA" Checking whether sum of the column is less than or equal to sum of first column of set
                Cells(x, 7).Value = Cells(x, 2).Value
            End If
        Next o

    Next k

    Set m = m.Offset(43)
    multi = multi + 43
Next i

The problem is that the condition for copying copy (The sum should be less than certain value) is not working. It actually copies all the data from column 2 to column 7.

Can someone help in finding what might be the reason for this...

NOTE: I checked and confirmed that the code to store row numbers in column 50 is working fine. So the problem might be in the lower half of the code which is the for loop with variable "o"

Its not giving an error on compilation so i assume it is done implicitly while executing for loop... — Avi Gupta, May 10 '17 at 09:47
Add `Option Explicit` to the top of your module. When you compile, it will highlight any undeclared variables. Repeat until you get a clean compile. — Mark Fitzgerald, May 10 '17 at 10:45
The compile is actually clean there is no error on compile. The output is garbage... There seems to be some error in the logic i have built for achieving my objective... — Avi Gupta, May 10 '17 at 10:51

score 0 · Accepted Answer · edited May 13 '17 at 05:40

I went ahead and pushed this myself with this.

Realized there were multiple mistakes:

I had to initialize the new column to 0. That I missed. Changed column from 7 to 6 due to some reasons.
I did not exit the main for-loop when the criteria was reached due to which the process went on even after the process was supposed to be complete. Used the Boolean variable flag for this.
While counting for the iterations involving the repetition of the value given by small function, the variable "l" was counted one +1. Made suitable adjustments. (Changed column from 50 to 500 due to some reason)
I observed that Excel was not updating the calculated valued by itself, so included Application.Calculate function at the beginning.

Here is the working code:

Application.Calculate
Dim m As Range, cl As Range, k As Double, b As Double, lIndex As Double, a As Double, multi As Double, l As Double, x As Double, Check As Double, flag As Boolean
    l = 2
    Set m = ActiveSheet.Range("E3:E40")
    multi = 2                                                             'To move to starting position of the data set
    flag = False

    For i = 1 To 172

        b = 45 + 43 * (i - 1)
        Cells(b, 6).Value = 0

        For p = 3 To 40

            Cells(p + ((i - 1) * 43), 6).Value = 0                               'Initializing to column no. 6 to 0

        Next p

        For k = 1 To 38

            If flag = True Then
            flag = 0
            Exit For
            End If

            If k + l - 2 <= 38 Then
                a = Application.Small(m, (k + l - 2))
                k = k + l - 2
            Else
                Exit For
            End If

            l = 1

            For j = 1 To 38

                Cells(j, 500).Value = 0                                     'Initializing to column no. 500 to 0

                If Cells(j + multi, 5).Value = a Then                      'Checking for match
                    Cells(l, 500).Value = j + multi                         'Storing Row coordinates in column no. 500
                    l = l + 1
                End If

            Next j

            For o = 1 To l - 1

                x = Cells(o, 500).Value
                Cells(x, 6).Value = 0
                Cells(b, 6).Value = Cells(b, 6).Value + Cells(x, 2).Value
                Check = Cells(b, 6).Value
                If Cells(b, 6).Value <= Cells(b, 1).Value Then             'Checking whether sum of the column is less than or equal to sum of first column of set
                    Cells(x, 6).Value = Cells(x, 2).Value
                Else:
                    Cells(x, 6).Value = Cells(b, 1).Value - (Cells(b, 6).Value - Cells(x, 2).Value)
                    Cells(b, 6).Value = Cells(b, 6).Value - Cells(x, 2).Value + Cells(x, 6).Value
                    flag = True
                Exit For
                End If

            Next o

        Next k

        Set m = m.Offset(43)
        multi = multi + 43

    Next i

End Sub

Logical Error in my code

1 Answers1