Microsoft Office Tutorials and References
In Depth Information
Example 19-11. The SelectIfSame Procedure
Next ' row
' Select the range
If cMatches > 0 Then
cmdUndo.Enabled = False
MsgBox "No matching cells. Selection will not be changed.",
cmdUndo.Enabled = False
End If
End Sub
The SelectIfSame procedure, which is shown in Example 19-11 , is very similar to the
SelectIfDifferent procedure. One significant difference is that we do not include the first
Example 19-11. The SelectIfSame Procedure
Private Sub SelectIfSame()
Dim rngMatch As Range
Dim vCellValue As Variant
Dim vPreviousCellValue As Variant
Dim cMatches As Integer
Dim oCell As Object
Dim cRows As Integer, cColumns As Integer
Dim r As Integer, c As Integer
' Get row and column count (one of which is 1)
cColumns = rngSearch.Columns.Count
cRows = rngSearch.Rows.Count
' Start search
cMatches = 0
Set rngMatch = Nothing
For r = 1 To cRows
For c = 1 To cColumns
Set oCell = rngSearch.Cells(r, c)
vCellValue = oCell.Value
vCellValue = CStr(vCellValue)
If r = 1 And c = 1 Then
' Save first value for next comparion
vPreviousCellValue = vCellValue
' Do comparison with previous cell
vCellValue = rngSearch.Cells(r, c).Value
vCellValue = CStr(vCellValue)
If vCellValue = vPreviousCellValue Then
If rngMatch Is Nothing Then
Set rngMatch = oCell
Set rngMatch = Application.Union(rngMatch, oCell)
End If
cMatches = cMatches + 1
End If
' Save value for next comparion
Search JabSto ::

Custom Search