x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 208

# Help with Numbers

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
eciabattari
4 Solutions

Commented:
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

Middle School Assistant TeacherCommented:
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

Commented:
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

Commented:
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 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
xx = xx+1
End If
Next x

For x = 0 To UBound(answer)
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 Commented:
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

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

Commented:
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

Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.