Using The Range Find Method
For the most advanced usage of the Range.Find method, Rich's newest book not only includes detailed instructions but also provides a downloadable app showing the full source code for using the Range.Find method in the most exacting applications.
Power-Up Using Excel VBA Sorts and Searches
The Range Find Method allows the user to search for one or more occurrances of a variable within a range. It is useful when you want to search for items in all the rows and columns of a range. The example below locates multiple occurrances of a particular cell value and copies that cell value plus the next three cells to the right in the same row to a separate sheet.
Program Code
Option Explicit
Dim C As Range
Dim rngCopyRange As Range
Dim FirstAddress As String
Dim shtSheet1 As Worksheet
Dim shtSheet2 As Worksheet
Dim lngSheet2LastRow As Long
' ***************************************************************
' Find All SA64 Values And Copy That Cell + Three Cells To the
' Right To Sheet 2
' ***************************************************************
Public Sub FindSA64()
Set shtSheet1 = Sheets("Sheet1")
Set shtSheet2 = Sheets("Sheet2")
' ***************************************************************
' Assume Column A Always Has Data
' ***************************************************************
lngSheet2LastRow = shtSheet2.Cells(Rows.Count, "A").End(xlUp).Row
' ***************************************************************
' Change Sheet1 Range to Your Requirements Or Make It Dynamic
' A1:K500 Is Only For Demo Purposes
' ***************************************************************
With shtSheet1.Range("A1:K500")
Set C = .Find("SA64", LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
Call CopyData
Set C = .FindNext(C)
If C Is Nothing Then Exit Do
Loop Until C.Address = FirstAddress
End If
End With
End Sub
Public Sub CopyData()
lngSheet2LastRow = lngSheet2LastRow + 1
Set rngCopyRange = Range(C, C.Offset(0, 3))
rngCopyRange.Copy shtSheet2.Cells(lngSheet2LastRow, 1)
End Sub
' *************************************************************************
' The Following Similar Example Searches For Multiple Values
' *************************************************************************
Option Explicit
Dim C As Range
Dim rngCopyRange As Range
Dim FirstAddress As String
Dim shtSheet1 As Worksheet
Dim shtSheet2 As Worksheet
Dim lngSheet2LastRow As Long
Dim strStringToFind() As Variant
Dim intNumberOfSearchItems As String
Dim i As Integer
' ***************************************************************
' Find All SA64 Values And Copy That Cell + Three Cells To the
' Right To Sheet 2
' ***************************************************************
Public Sub FindSA64()
' ***************************************************************
' Change "2" to the Number Of Items To Be Searched
' ***************************************************************
ReDim strStringToFind(1 To 2)
strStringToFind(1) = "SA59"
strStringToFind(2) = "SA65"
intNumberOfSearchItems = UBound(strStringToFind)
Set shtSheet1 = Sheets("Sheet1")
Set shtSheet2 = Sheets("Sheet2")
' ***************************************************************
' Assume Column A Always Has Data
' ***************************************************************
lngSheet2LastRow = shtSheet2.Cells(Rows.Count, "A").End(xlUp).Row
' ***************************************************************
' Change Sheet1 Range to Your Requirements Or Make It Dynamic
' A1:K500 Is Only For Demo Purposes
' ***************************************************************
For i = 1 To intNumberOfSearchItems
With shtSheet1.Range("A1:K500")
Set C = .Find(strStringToFind(i), LookIn:=xlValues)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
Call CopyData
Set C = .FindNext(C)
If C Is Nothing Then Exit Do
Loop Until C.Address = FirstAddress
End If
End With
Next i
End Sub
Private Sub CopyData()
lngSheet2LastRow = lngSheet2LastRow + 1
Set rngCopyRange = Range(C, C.Offset(0, 3))
rngCopyRange.Copy shtSheet2.Cells(lngSheet2LastRow, 1)
End Sub
' *************************************************************************
' Here's Another Way To Structure The Range Find Using a Do Loop
' This example replaces "--" with a special character for all cells
' in a UsedRange.
' *************************************************************************
Option Explicit
Sub ReplaceStringAK()
Dim FirstAddress As String
Dim C As Range
With ActiveSheet.UsedRange
Set C = .Find("--", LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If InStr(1, C.Value, "---") = 0 Then
C.Replace What:="--", Replacement:="ยง"
End If
Set C = .FindNext(C)
If C Is Nothing Then Exit Do
Loop Until C.Address = FirstAddress
End If
End With
End Sub