defining number range in textbox

[Ouka]

Hi all,

I have a worksheet that has a long list of ID numbers arranged in row
2.

I have a userform that lets the user enter comma delinated values in a
textbox. The script on the OK button on this user form checks the
validity of the entered IDs, and if valid, then removes that ID and
associated records from the activesheet and other worksheets.

I've been asked to upgrade the functionality of this form so the user
can do batch removals using ranged entries.

i.e. they want to be able to make an entry like "1, 3, 7, 10-25, 33,
45") and have all 21 of those values removed (and validity tested, of
course).

Sounded trival to them, but I have no idea how to approach this at all.
I've played with a few ideas but nothing has really worked.



My current code is as follows:

(userform textbox value replaced with simple activecell value.

To use:
1. place a series of integer values in column 1
2. place a series of comma delinated integer values in another cell
3. select that cell and fire the procedure)


Code:
--------------------
Private Sub CommandButton1_Click()

Dim I As Long
Dim valueString As String
Dim x As String

valueString = ActiveCell.Value ' the thing to parse
I = InStr(valueString, ",") ' find the first comma

If (I = 0) Then ' if no commas (single value)
x = Trim(valueString)
If IsNumeric(x) = False Then
GoTo invalidInteger
Exit Sub
End If
valueCheck (x)
End If

Do Until (valueString = "")

If (I = 0) And (valueString <> "") Then ' check in case our source does not end with a comma
x = Trim(valueString)
valueString = ""
Else
x = Trim(Left(valueString, I - 1)) ' get the latest value
valueString = Mid(valueString, I + 1) ' strip the value already gotten
End If

If IsNumeric(x) = False Then
GoTo invalidInteger
Exit Sub
End If

valueCheck (x)
I = InStr(valueString, ",") ' find the next comma

Loop

invalidInteger:
MsgBox "Invalid Entry." & Chr$(13) _
& x & " is not a valid numerical value." & Chr$(13) & Chr$(13) _
& "Please enter only interger values."

End Sub


Private Sub valueCheck(ByVal x As String)

Dim I As Integer
Dim lRow As Integer
lRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For I = 1 To lRow
If ActiveSheet.Cells(I, 1).Value = x Then
GoTo IsTrue
End If
Next I

MsgBox "Invalid entry." & Chr$(13) _
& x & " is not a valid ID number."
End

IsTrue:

End Sub
--------------------


Any input would be greatly appriciated!

--Ouka

 

[Bob Phillips]

Private Sub CommandButton1_Click()
Dim i As Long, j As Long
Dim iPos As Long, iPosPrev As Long
Dim iRow As Long, cLen As Long
Dim iFirst As Long, iLast As Long
Dim valueString As String, aryValues

valueString = ActiveCell.Value

iPosPrev = 1
cLen = Len(valueString)
aryValues = Split(valueString, ",")
For i = LBound(aryValues) To UBound(aryValues)
'extract the start and end numbers from the substring
If aryValues(i) Like "*-*" Then
iPos = InStr(1, aryValues(i), "-")
iFirst = Left(aryValues(i), iPos - 1)
iLast = Right(aryValues(i), Len(aryValues(i)) - iPos)
Else
iFirst = aryValues(i)
iLast = iFirst
End If
'process that range of values
For j = iFirst To iLast
iRow = 0
On Error Resume Next
iRow = Application.Match(j, Range("A:A"), 0)
On Error GoTo 0
If iRow > 0 Then
Rows(iRow).Delete
End If
Next j
Next i

End Sub