Find a value from a range on a sheet that 'contains' a string

[_DBB_]

I'm trying to create VBA that searches a worksheet for a cell in a row that contains a string - it then needs to check the expiry date is within 6 months from today(0 and copy all rows that meet the criteria to another sheet.

Search Worksheet = DELEGATES
String Value = RENEWALS sheet Cell B3
Post Sheet = Sheet2

Sub Renewals()
Dim aLastRow As Long
Dim yResults As Long
Dim xCourse As String
Dim foundRng As Range
aLastRow = Worksheets("DELEGATES").UsedRange.Rows.Count
yResults = Worksheets("Sheet2").UsedRange.Rows.Count

If yResults = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then yResults = 0
End If

xCourse = Worksheets("RENEWALS").Range("B3").Value
Set foundRng = Worksheets("DELEGATES").Range("R1:R" & aLastRow)

On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To foundRng.Count

If CStr(foundRng(K).Value) Like "*" & xCourse & "*" Then
foundRng(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next
Application.ScreenUpdating = True
MsgBox "Finished"

End Sub

 

[Yongle]

I simplified your code - hopefully it achieves required result

You did not tell us where expiry date is to be found
I assumed it is in column L (2 columns to right of R)

Cel.Offset(, 2)

Amend to match your data

'If found in column L (6 columns to left of R) then it would be
Cel.Offset(, -6)
'etc

Sub Renewals()

Dim ws As Worksheet, wsD As Worksheet, Cel As Range, xCourse As String, xDate As Date
Set ws = Sheets("Sheet2")
Set wsD = Sheets("DELEGATES")
xCourse = "*" & LCase(Worksheets("RENEWALS").Range("B3").Value) & "*"
xDate = Date + 180
Application.ScreenUpdating = False

For Each Cel In wsD.Range("R2", wsD.Range("R" & wsD.Rows.Count).End(xlUp))
    If LCase(Cel) Like xCourse Then
        If Cel.Offset(, 2) <= xDate Then Cel.EntireRow.Copy ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1)
    End If
Next Cel

End Sub