Solved

Help with Numbers

Posted on 2004-10-13
9
172 Views
Last Modified: 2010-05-02
Hi - need some help with determining if number is larger.
I've written the following code and it works, in part.

Here's what I'm trying to do.
1.  I do a search for everything greater than my search parameter (in this case 1.0.0).
2.  I want the search to return everything larger than 1.0.0 but smaller than 2.0.0 (i.e. 1.1.0,  1.1.1, 1.2.0, 1.3.0)
3.  If you pass the search paramerter 1.1.0 it should only return 1.1.1

Can anyone assist?  Thanks

'-----------------------------------------------------------------------------------
Private Sub SearchLarger(MySch As Variant)
    Dim abc As Integer
    Dim r3 As Long
    Dim s As Long
    Dim Arr1() As Long
    Dim Arr2() As Long
    Dim i As Long
    Dim i2 As Long
    On Error Resume Next

    'Loop through rows and list number of used cells per row
    For r3 = r To ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Next r3
   
    r3 = r3 - 1
    i = 0
   
    ReDim Arr1(0 To 5)
    ReDim Arr2(0 To 5)
   
    'loop that gets data
    For s = r To r3
    x = ws.Cells(s, 1)
   
        Arr1(0) = Split(MySch, ".")(0)
        Arr1(1) = Split(MySch, ".")(1)
        Arr1(2) = Split(MySch, ".")(2)
        Arr1(3) = Split(MySch, ".")(3)
        Arr1(4) = Split(MySch, ".")(4)
       
        Arr2(0) = Split(x, ".")(0)
        Arr2(1) = Split(x, ".")(1)
        Arr2(2) = Split(x, ".")(2)
        Arr2(3) = Split(x, ".")(3)
        Arr2(4) = Split(x, ".")(4)
       
        If Arr1(1) = "" Then Arr(1) = 0
        If Arr1(2) = "" Then Arr(2) = 0
        If Arr1(3) = "" Then Arr(3) = 0
        If Arr1(4) = "" Then Arr(4) = 0
       
        If Arr2(1) = "" Then Arr(1) = 0
        If Arr2(2) = "" Then Arr(2) = 0
        If Arr2(3) = "" Then Arr(3) = 0
        If Arr2(4) = "" Then Arr(4) = 0

        If Arr1(0) = Arr2(0) Then                     <------------------this is where I have problems
            i = i + 1
            If Arr1(1) > Arr2(1) Then
                i = i + 1
            End If
                If Arr1(2) > Arr2(2) Then
                    i = i + 1
                End If
                    If Arr1(3) > Arr2(3) Then
                        i = i + 1
                    End If
                        If Arr1(4) > Arr2(4) Then
                            i = i + 1
                        End If
        End If
    Next s

End Sub
'-----------------------------------------------------------------------------------
0
Comment
Question by:eciabattari
9 Comments
 
LVL 8

Accepted Solution

by:
ampapa earned 125 total points
ID: 12301837
This is just a thought but it might work for what you are doing? If all your number formats are the same then Spit() the items then concantonate them into a single string then convert them to a number using CINT().

After you have an array of your new numbers then run the routine of finding items greater or less than your criteria.
0
 
LVL 85

Assisted Solution

by:Mike Tomlinson
Mike Tomlinson earned 125 total points
ID: 12302143
I think ampapa has a great idea.

It looks like you expect the version to have up to five slots in it.
The following code converted these versions to the values shown below:
 1.1
 1.5.3.1
 1.6.2
 2.0
 2.1.2.3.1

 11000
 15310
 16200
 20000
 21231

Private Sub Command1_Click()
    Debug.Print getVersionValue("1.1", 5)
    Debug.Print getVersionValue("1.5.3.1", 5)
    Debug.Print getVersionValue("1.6.2", 5)
    Debug.Print getVersionValue("2.0", 5)
    Debug.Print getVersionValue("2.1.2.3.1", 5)
End Sub

Private Function getVersionValue(ByVal version As String, ByVal versionSlots As Integer) As Integer
    Dim values As Variant
    Dim strValues As String
    Dim i As Integer
   
    values = Split(version, ".")
    strValues = Join(values, "")
    ' add zeroes for missing version slots
    For i = (UBound(values) + 1) To (versionSlots - 1)
        strValues = strValues & "0"
    Next i
    getVersionValue = CInt(strValues)
End Function
0
 
LVL 5

Assisted Solution

by:gary_j
gary_j earned 125 total points
ID: 12302925
Are there only 3 segments or 5 segments or anything up to 5 segments.

If it was always 3 segments, I would just do a replace like this:

strA = "1.0.0"
strB = "1.0.1"
strC = "2.0.0"
strSearch = "1.0.0"

intSearch = cint(replace(strSearch,".",""))
intSearchHigh = intSearch + 100
intA = cint(replace(strA,".",""))
intB = cint(replace(strB,".",""))
intC = cint(replace(strC,".",""))

if intA > intSearch and intA < intSearchHigh then print "true" else print "false"
etc ...

If the strings weren't always the same number of segments, I would add segments consisting of "0" to the front of them to make them the same size, then code accordingly

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 8

Expert Comment

by:ampapa
ID: 12304133
I won't recreate the wheel, nice function Idle Mind I always forget about the "Join" function.... The below will give you a rough idea. I hope it helps.


Private Sub Command1_Click()
Dim sort(4)
Dim answer()
Dim x,xx, y, z As Integer
   
y = 15315
z = 20000

    sort(0) = getVersionValue("1.1", 5)
    sort(1) = getVersionValue("1.5.3.1", 5)
    sort(2) = getVersionValue("1.6.2", 5)
    sort(3) = getVersionValue("2.0", 5)
    sort(4) = getVersionValue("2.1.2.3.1", 5)
   
    xx = 0
    For x = 0 To UBound(sort)
        If sort(x) > y And sort(x) < z Then
            ReDim answer(xx)
            answer(xx) = sort(x)
            xx = xx+1
        End If
    Next x

    For x = 0 To UBound(answer)
        MsgBox answer(x)
    Next x


End Sub

Private Function getVersionValue(ByVal version As String, ByVal versionSlots As Integer) As Integer
    Dim values As Variant
    Dim strValues As String
    Dim i As Integer
   
    values = Split(version, ".")
    strValues = Join(values, "")
    ' add zeroes for missing version slots
    For i = (UBound(values) + 1) To (versionSlots - 1)
        strValues = strValues & "0"
    Next i
    getVersionValue = CInt(strValues)
End Function
0
 

Author Comment

by:eciabattari
ID: 12310629
I figured it out... thanks for the help.

Here's what I did:
1.  Create a form with seven labels on it, name labels lbl1, lbl2 ... lbl7
2.  Create another label on same form, call "Label1"
3.  Create a command button, called "Command1" and use the following for Caption "GoBack"
4.  Create an Excel spreadsheet and past the follow into Sheet 1
5.  Past the code below into code for form 1.

'--------------------------------
 A            B                 C
1.0.0      4      
1.1.0            file
1.2.0            file
1.3.0            file
1.4.0            file
2.0.0            
2.1.0      7      file
2.2.0            file
2.3.0            
2.3.1            
2.3.1.1            file
2.3.1.2            file
2.4.0            
3.0.0            
3.1.0      8      file
3.2.0            file
3.3.0            
3.3.1            file
3.3.2            file
3.4.0            file
3.5.0            file
3.6.0            file
4.0.0            
4.1.0      3      file
4.2.0            
4.2.1            file
4.2.2            file
5.0.0            file
'----------------------------------------------------------------------------------------------------------
Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim lngLevel As String
Dim lngLevelat As Long
Dim x As Variant
Dim p As Variant
Dim strSearchValue As Variant
Dim arr() As Variant

Dim level2 As Long
Dim level3 As Long
Dim level4 As Long
Dim level5 As Long

Dim r As Long
Dim strCells As Long
Dim r2 As Long
Dim strPass As Variant

Private Sub Command1_Click()
    Call Level1Info
End Sub

Private Sub Level1Info()
On Error GoTo errHandler
   
    Set wb = xl.Workbooks.Open(App.Path & "\Book1.xls")
    Set ws = wb.Worksheets("Sheet1")
   
    'Loop through rows and list number of used cells per row
    For r = 1 To ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Next r

    strCells = r - 1
   
    'loop that gets data
    For r = 1 To strCells
        x = ws.Cells(r, 1)
        Call CheckLarger(x)
       
        If lngLevel = 1 Then
            r2 = r2 + 1
            Call CheckStringLength(x)
            Call ShowLabels(x)
            lngLevelat = 1
        End If
        lngLevel = 0
    Next r

    'cleanup
    wb.Application.Workbooks(1).Save
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set ws = Nothing
Exit Sub

errHandler:
    Debug.Print "Error Number: " & Err.Number & " Error Description: " & Err.Description
   
    'cleanup
    wb.Application.Workbooks(1).Save
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set ws = Nothing

End Sub

Private Sub CheckLarger(MySch As Variant)
    Dim abc As Integer
    Dim arr() As Variant
   
    On Error Resume Next
    ReDim arr(0 To 5)
       
        arr(0) = Split(MySch, ".")(0)
        arr(1) = Split(MySch, ".")(1)
        arr(2) = Split(MySch, ".")(2)
        arr(3) = Split(MySch, ".")(3)
        arr(4) = Split(MySch, ".")(4)
       
        If arr(1) = "" Then arr(1) = 0
        If arr(2) = "" Then arr(2) = 0
        If arr(3) = "" Then arr(3) = 0
        If arr(4) = "" Then arr(4) = 0
       
        If arr(0) > 0 Then
            If arr(1) = 0 Then
                lngLevel = 1
                GoTo nextValue
            End If
                If arr(2) = 0 Then
                    lngLevel = 2
                    GoTo nextValue
                End If
                    If arr(3) = 0 Then
                        lngLevel = 3
                        GoTo nextValue
                    End If
                        If arr(4) = 0 Then
                            lngLevel = 4
                            GoTo nextValue
                        End If
nextValue:
        End If
       
End Sub

Private Sub CheckStringLength(strNumber As Variant)
    Dim strNumberCheck As Variant
   
    strNumberCheck = Len(strNumber)
   
    If strNumberCheck = 1 Then
        x = x & ".0"
    End If
   
End Sub

Private Sub Form_Load()
    Call HideLabels
    lngLevelat = 0
    level2 = 0
    level3 = 0
    level4 = 0
    level5 = 0
   
End Sub

Private Sub Label1_Click()
    'lngLevelat = lngLevelat - 1
   
    Debug.Print lngLevelat
   
    Select Case lngLevelat
        Case 2
            Call HideLabels
            r2 = 0
            Call Level1Info
           
        Case 3
            Call HideLabels
            r2 = 0
            Debug.Print strSearchValue
            Call Level1Info

        Case 4
            Call HideLabels
            r2 = 0
            Call Level1Info
           
        Case 5
            Call HideLabels
            r2 = 0
            Call Level1Info
           
    End Select

End Sub

Private Sub lbl1_Click()
    strSearchValue = lbl1.Caption
    Call SearchValue
End Sub
Private Sub lbl2_Click()
    strSearchValue = lbl2.Caption
    Call SearchValue
End Sub
Private Sub lbl3_Click()
    strSearchValue = lbl3.Caption
    Call SearchValue
End Sub
Private Sub lbl4_Click()
    strSearchValue = lbl4.Caption
    Call SearchValue
End Sub
Private Sub lbl5_Click()
    strSearchValue = lbl5.Caption
    Call SearchValue
End Sub

Private Sub HideLabels()
    lbl1.Visible = False
    lbl2.Visible = False
    lbl3.Visible = False
    lbl4.Visible = False
    lbl5.Visible = False
    lbl6.Visible = False
    lbl7.Visible = False
End Sub

Private Sub SearchValue()
On Error GoTo errHandler

    Set wb = xl.Workbooks.Open(App.Path & "\Book1.xls")
    Set ws = wb.Worksheets("Sheet1")
   
    'Loop through rows and list number of used cells per row
    For r = 1 To ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Next r

    strCells = r - 1
   
    'loop that gets data
    For r = 1 To strCells
        x = ws.Cells(r, 1)
        p = ws.Cells(r, 3)
       
        If strSearchValue = x And p = "" Then
            lngLevelat = lngLevelat + 1
            Call SearchLarger(strSearchValue)
            GoTo endValue
        End If
    Next r

endValue:
    'cleanup
    wb.Application.Workbooks(1).Save
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set ws = Nothing
Exit Sub

errHandler:
    Debug.Print "Error Number: " & Err.Number & " Error Description: " & Err.Description
   
    'cleanup
    wb.Application.Workbooks(1).Save
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set ws = Nothing
   
End Sub

Private Sub SearchLarger(MySch As Variant)
    Dim abc As Integer
    Dim r3 As Long
    Dim s As Long
    Dim Arr1() As Variant
    Dim Arr2() As Variant
    Dim Arr3() As Variant
    Dim i As Long
    Dim i2 As Long
    Dim z As Variant
   
    Dim lvl2a As Long
    Dim lvl3a As Long
    Dim lvl4a As Long
    Dim lvl5a As Long
   
    On Error Resume Next
   
    'Loop through rows and list number of used cells per row
    For r3 = r To ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Next r3
   
    r3 = r3 - 1
    i = 0
    lvl2a = 1
    lvl3a = 1
    lvl4a = 1
    lvl5a = 1

    ReDim Arr1(0 To 5)
    ReDim Arr2(0 To 5)
    ReDim Arr3(0 To 5)
   
    'loop that gets data
    For s = r To r3
    x = ws.Cells(s, 1)
   
        Arr1(0) = Split(MySch, ".")(0)
        Arr1(1) = Split(MySch, ".")(1)
        Arr1(2) = Split(MySch, ".")(2)
        Arr1(3) = Split(MySch, ".")(3)
        Arr1(4) = Split(MySch, ".")(4)
       
        Arr2(0) = Split(x, ".")(0)
        Arr2(1) = Split(x, ".")(1)
        Arr2(2) = Split(x, ".")(2)
        Arr2(3) = Split(x, ".")(3)
        Arr2(4) = Split(x, ".")(4)
       
        If Arr1(1) = "" Then arr(1) = 0
        If Arr1(2) = "" Then arr(2) = 0
        If Arr1(3) = "" Then arr(3) = 0
        If Arr1(4) = "" Then arr(4) = 0
       
        If Arr2(1) = "" Then Arr2(1) = 0
        If Arr2(2) = "" Then Arr2(2) = 0
        If Arr2(3) = "" Then Arr2(3) = 0
        If Arr2(4) = "" Then Arr2(4) = 0
       
        'determins what the For loop should be for the number selected
        If Arr1(0) = Arr2(0) Then
            i = i + 1
            If Arr1(1) > Arr2(1) Then
                i = i + 1
            End If
                If Arr1(2) > Arr2(2) Then
                    i = i + 1
                End If
                    If Arr1(3) > Arr2(3) Then
                        i = i + 1
                    End If
                        If Arr1(4) > Arr2(4) Then
                        i = i + 1
                        End If
        End If
    Next s
   
    If i = 1 Then
       'do nothing
        Exit Sub
    Else
        Call HideLabels
        s = 0
        r2 = 0
        i2 = r + i - 1
       
        'loop that gets data
        For s = r + 1 To i2
            r2 = r2 + 1
            x = ws.Cells(s, 1)
           
                Arr3(0) = Split(x, ".")(0)
                Arr3(1) = Split(x, ".")(1)
                Arr3(2) = Split(x, ".")(2)
                Arr3(3) = Split(x, ".")(3)
                Arr3(4) = Split(x, ".")(4)
       
                If Arr3(1) = "" Then Arr3(1) = 0
                If Arr3(2) = "" Then Arr3(2) = 0
                If Arr3(3) = "" Then Arr3(3) = 0
                If Arr3(4) = "" Then Arr3(4) = 0
               
                Select Case lngLevelat
                       
                    Case 2  'level 2
                        If Arr3(1) = lvl2a Then
                            lvl2a = lvl2a + 1
                        Else
                            r2 = r2 - 1
                            GoTo nextRow
                        End If
                   
                    Case 3  'level 3
                        If Arr3(2) = lvl3a Then
                            lvl3a = lvl3a + 1
                        Else
                            GoTo nextRow
                        End If
                       
                    Case 4  'level 4
                        If Arr3(3) = lvl4a Then
                            lvl4a = lvl4a + 1
                        Else
                            GoTo nextRow
                        End If
                       
                    Case 5  'level 5
                        If Arr3(4) = lvl5a Then
                            lvl5a = lvl5a + 1
                        Else
                            GoTo nextRow
                        End If
                   
                End Select
           
            Call ShowLabels(x)
           
nextRow:

        Next s
    End If

End Sub

Private Sub ShowLabels(strLabelValue As Variant)
    Select Case r2
        Case "1"
            lbl1.Caption = strLabelValue
            lbl1.Visible = True
        Case "2"
            lbl2.Caption = strLabelValue
            lbl2.Visible = True
        Case "3"
            lbl3.Caption = strLabelValue
            lbl3.Visible = True
        Case "4"
            lbl4.Visible = True
            lbl4.Caption = strLabelValue
        Case "5"
            lbl5.Visible = True
            lbl5.Caption = strLabelValue
        Case "6"
            lbl6.Visible = True
            lbl6.Caption = strLabelValue
        Case "7"
            lbl7.Visible = True
            lbl7.Caption = strLabelValue
        End Select

End Sub

0
 
LVL 27

Assisted Solution

by:Ark
Ark earned 125 total points
ID: 12343349
You can add invisible listbox with sorted=true, fill it with cells values and get next item after MchVar. To find MchVar in a hidden list box you can use For i=0 to lbHidden.Count-1 loop, or, to increase speed, SendMessage(lbHidden.hwnd, LB_FINDSTRINGEXACT,-1,ByVal 0&)

Regards
Ark
0
 
LVL 27

Expert Comment

by:Ark
ID: 12443804
Oops, sorry, should be:
Dim sFind As String
sSearch=CStr(MchVar)
idx = SendMessage(lbHidden.hwnd, LB_FINDSTRINGEXACT,-1,ByVal sSearch)
sFound = lbHidden.List(idx+1)
'where sFound is next version greater then sSearch (if nothing found, idx will be = -1 and sFound will be equal to first version)
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now