Search This Blog

Wednesday, August 24, 2011

Comparing sets of data (lower and upper limit)

Data set:
0.5, 1.5, 2.1, 0.43, 0.35

condition/base number : 1

Result needed:
To select number nearest to 1 ie.= 0.5 by using macro.

Note: Although 1.5 is also near to 1 (also a 0.5 difference), it must choose the smaller number.
(0.5 is smaller as compared to 1.5) 




Solution:


Sub FindClosest()
    Const CONDITION_NUMBER = 1
    Const COLUMNS_OF_DATA = 7
    
    Dim intCount As Integer
    Dim sngNums() As Single
    ReDim sngNums(COLUMNS_OF_DATA)
    Dim sngMinDiff As Single
    Dim sngTemp As Single
    Dim intResult As Integer
    Dim strTemp As String
    Dim lngRow As Long
    Dim strRow As String
    Dim lngBottom As Long
    Dim intTemp As Integer
    
    ActiveCell.SpecialCells(xlLastCell).Select
    lngBottom = ActiveCell.Row
        
    For lngRow = 2 To lngBottom
        strRow = Trim(Str(lngRow))
       ' Populate an array with the differences. PURPOSE: TO REDUCE NUMBER OF LOCATIONS IN WAREHOUSE
       For intCount = 1 To COLUMNS_OF_DATA
           If intCount < 3 Then
               strTemp = Chr(88 + intCount)
           Else
               intTemp = (intCount - 3) / 26
               strTemp = Chr(65 + intTemp) & Chr(62 + intCount - (26 * intTemp))
           End If
           sngNums(intCount) = CONDITION_NUMBER - Range(strTemp & strRow).Value
       Next
    
       ' Start by finding a value that we know is not right that we can use to work our way in.
       ' Get the larger of the differences from the smallest and largest numbers in the source range
       If COLUMNS_OF_DATA < 3 Then
           strTemp = Chr(88 + COLUMNS_OF_DATA)
       Else
           intTemp = (COLUMNS_OF_DATA - 3) / 26
           strTemp = Chr(65 + intTemp) & Chr(62 + COLUMNS_OF_DATA - (26 * intTemp))
       End If
       sngTemp = Abs(CONDITION_NUMBER - (Application.WorksheetFunction.Max(Range("Y" & strRow & ":" & strTemp & strRow))))
       sngMinDiff = Abs(CONDITION_NUMBER - (Application.WorksheetFunction.Min(Range("Y" & strRow & ":" & strTemp & strRow))))
       
       If sngTemp > sngMinDiff Then sngMinDiff = sngTemp
       
       ' Now as we go through the numbers, we know we'll get something that's BIGGER.
       ' Or, if they're all the same, it won't matter which we select.
       intResult = 1
       For intCount = 1 To COLUMNS_OF_DATA
           ' If the abs of the difference is smaller, collect the BIGGER number.
           If Abs(sngNums(intCount)) < sngMinDiff Then
               sngMinDiff = Abs(sngNums(intCount))
               intResult = intCount
           End If
           ' If the abs of the diff is the same, but the original # is lower than the
           ' condition, point to that one instead. RULE OF THUMB: choose nearer to 1 but if btw 0.5 and 1.5, choose 1.5.
           If Abs(sngNums(intCount)) = sngMinDiff And sngNums(intCount) < 0 Then
               intResult = intCount
           End If
       Next
       If intResult < 3 Then
           strTemp = Chr(88 + intResult)
       Else
           intTemp = (intResult - 3) / 26
           strTemp = Chr(65 + intTemp) & Chr(62 + intResult - (26 * intTemp))
       End If
       sngTemp = range(strTemp & strRow).Value
       ' Now intResult holds the index of the closest number that is lower than the condition.
       If COLUMNS_OF_DATA = 1 Then
           strTemp = "Z"
       Else
           intTemp = (COLUMNS_OF_DATA - 2) / 26
           strTemp = Chr(65 + intTemp) & Chr(63 + COLUMNS_OF_DATA - (26 * intTemp))
       End If
       Range(strTemp & strRow).Formula = sngTemp
    Next
End Sub

No comments:

Post a Comment