In Linking Userforms and Worksheets I demonstrated some techniques for displaying data on a userform. Recently, a newsgroup poster was trying to do the same thing, but only with records that matched a certain criterion.
This post shows how I would do it, but not necessarily the best or only way to do it. First, I use the Find method to establish the range of records I want to show. I then pass that range to the userform using a custom property that I created with the Property Set statement.
I want to make sure that the range references inside the passed range are in the same order as they appear on the worksheet. To do that, I use the After argument of the Find method and set it to the last cell in the searched range. This forces Find to start looking in the first cell of the range. Also, I don’t want want to use the Union function when I get back to the first found cell because that would screw up the order. So I used an If statement to skip that step on the last iteration of the Do Loop.
Here’s the code that establishes the range and calls the userform:
Dim ufPos As UPos ‘my userform variable
Dim rFound As Range ‘stores the currently found cell
Dim rPORange As Range ‘the range to search
Dim sFirstAdd As String ‘the address of the first found cell
Dim rAllFound As Range ‘all the found cells
‘Get the date from the user any way you want, I just hardcoded it
‘for this example
Const lPONUM As Long = 12345
Set rPORange = Sheet1.Range(“A2:A7”)
‘Find the first occurence. The After argument keeps them in the proper order
Set rFound = rPORange.Find(lPONUM, rPORange(rPORange.Cells.Count), xlValues, xlWhole)
‘If something is found
If Not rFound Is Nothing Then
‘store the address of the first found cell
sFirstAdd = rFound.Address
‘add the found cell to the range of all found cells
Set rAllFound = rFound
‘Try to find more cells and add them to rAllFound
‘Stop when Find loop around to the beginning
Do
Set rFound = rPORange.FindNext(rFound)
If rFound.Address <> sFirstAdd Then
Set rAllFound = Union(rAllFound, rFound)
End If
Loop Until rFound.Address = sFirstAdd
‘Create the userform
Set ufPos = New UPos
‘Pass the range to the userform
Set ufPos.AllFound = rAllFound
ufPos.Initialize
ufPos.Show
Else
MsgBox “No POs match that number”
End If
Set ufPos = Nothing
End Sub
In the userform class module, I have some module level variables to hold the range that I pass and the range whose information is currently showing.
Private mrCurrent As Range
Property Set AllFound(RHS As Range)
Set mrAllFound = RHS
End Property
I also have an Initialize procedure that I call before showing the form that populates the controls for the first record.
‘set the current record to the first cell
If Not mrAllFound Is Nothing Then
Set mrCurrent = mrAllFound(1)
Me.tbxPoNum.Text = mrCurrent.Value
Me.tbxPoDesc.Text = mrCurrent.Next.Value
Me.tbxY.Text = mrAllFound.Cells.Count
Me.tbxX.Text = 1
End If
End Sub
The two buttons use the FindNext and FindPrevious methods to get to the next appropriate record. Since mrAllFound will only contain cells that met the criteria of the first Find, the FindNext method will never find a non-matching record.
‘Set the current cell
Set mrCurrent = mrAllFound.FindNext(mrCurrent)
Me.tbxPoNum.Text = mrCurrent.Value
Me.tbxPoDesc.Text = mrCurrent.Next.Value
‘increment the counter
Me.tbxX.Text = Me.tbxX.Text + 1
End Sub
Private Sub cmdPrev_Click()
Set mrCurrent = mrAllFound.FindPrevious(mrCurrent)
Me.tbxPoNum.Text = mrCurrent.Value
Me.tbxPoDesc.Text = mrCurrent.Next.Value
Me.tbxX.Text = Me.tbxX.Text – 1
End Sub
Finally, when the X textbox changes, I enable or disable the buttons so the user can’t try to get to records that don’t exist.
‘enable/disable buttons
If Me.tbxX.Text = 1 Then
Me.cmdPrev.Enabled = False
Else
Me.cmdPrev.Enabled = True
End If
If Me.tbxX.Text = Me.tbxY.Text Then
Me.cmdNext.Enabled = False
Else
Me.cmdNext.Enabled = True
End If
End Sub
Public Sub Initialize()
‘set the current record to the first cell
If Not mrAllFound Is Nothing Then
Set mrCurrent = mrAllFound(1)
Me.tbxPoNum.Text = mrCurrent.Value
Me.tbxPoDesc.Text = mrCurrent.Next.Value
Me.tbxX = 1
Me.tbxY = mrAllFound.Cells.Count
End If
End Sub
You can download UnionLoop.zip
I recognize that problem. ExcelNut1954… It is good to see the whole package all put together. Very nice job…
I’ve only skimmed this Dick – could you not use filtered database?