Search & copy results to new sheet

[Tom2020]

Hello
I am looking for a VBA solution and hope someone can help me.
In a sheet, it should use input-box to search text and number. If it finds desired result(s) in a Range (A10:H3000), it should copy the whole row to the cell to the new sheet (start with A10), and highlight results (text or number) with Red.
This search should repeat
Thx for your help
Tom

 

[Sahak]

Hi Tom,

What kind of data do you have in range A10:H3000, all columns have the same kind of data (text & number, like ABS48 or 502BD or, ..... )? Give an example of your data in the range.
What kind of data should be entered in Input-box for search? Give an example.

 

[Tom2020]

Hi Sahak,
It could be.
The Range between A10 to H3000 has different type of date, like number, text, Email, or a combination e.g. "ABS48" or "Jackson Experience" …, etc.

You can put some data is not limited of . If FIND function doesn’t find anything, it shows a msgbox, no record.

If someone put in inputbox "call" (low-/uppercase no matter) for instance, it should list two records as attached screenshot, because it finds "call" in Row 10 and Row 11

Thx for your help

 

[Tom2020]

correct pix, sorry!

 

[Sahak]

Should input box value be searched in column E only or in all columns (A:H)?

 

[Tom2020]

in all columns (A:H), please
thx

 

[Sahak]

Try this

Sub Find_N_Copy()
    Range(Range("A10"), Range("A10").End(xlDown).Offset(0, 7)).Name = "SearchRng"
    FindString = InputBox("Please Enter a Search Value")
    If Trim(FindString) <> "" Then
        Dim SGCell As Range
        For Each SGCell In Range("SearchRng")
            If UCase(SGCell.Value) = UCase(FindString) Then
                Dim FoundCount As Long
                FoundCount = FoundCount + 1
                SGCell.Interior.Color = 255
                Dim TargetSheet As Worksheet
                Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
                Range(SGCell, SGCell.Offset(0, 8)).Copy Destination:=TargetSheet.Range("A" & TargetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1)
            End If
        Next
        If FoundCount = 0 Then MsgBox "No Record"
   End If
End Sub

 

[Tom2020]

Try this

Sub Find_N_Copy()
    Range(Range("A10"), Range("A10").End(xlDown).Offset(0, 7)).Name = "SearchRng"
    FindString = InputBox("Please Enter a Search Value")
    If Trim(FindString) <> "" Then
        Dim SGCell As Range
        For Each SGCell In Range("SearchRng")
            If UCase(SGCell.Value) = UCase(FindString) Then
                Dim FoundCount As Long
                FoundCount = FoundCount + 1
                SGCell.Interior.Color = 255
                Dim TargetSheet As Worksheet
                Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
                Range(SGCell, SGCell.Offset(0, 8)).Copy Destination:=TargetSheet.Range("A" & TargetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1)
            End If
        Next
        If FoundCount = 0 Then MsgBox "No Record"
   End If
End Sub

Thanks for your help,
I have some difficulties to get the results done, I have uploaded a screenshot to get more Ideas how the sheet (memo) looks like:
the issues are
-if I search for “Call”, I can find only one, instead of 4.
-for “after 2023”, I got "No Record"
-for “gifts this year” got "No Record"
-for “mrexcel” got "No Record"
-when I enter the search value “52345”, it finds, but generally no value should be highlighted in origin sheet (memo), it should happen only only in "sheet2”.

Thank you!

 

[Sahak]

How about this?

Sub Find_N_Copy_2()
    Range(Range("A10"), Range("A10").End(xlDown).Offset(0, 7)).Name = "SearchRng"
    FindString = InputBox("Please Enter a Search Value")
    If Trim(FindString) <> "" Then
        Dim SGCell As Range
        For Each SGCell In Range("SearchRng")
            Dim foundRng As Range
            Set foundRng = SGCell.Find(FindString)
            If Not foundRng Is Nothing Then
                Dim FoundCount As Long
                FoundCount = FoundCount + 1
                foundRng.Interior.Color = 255
                Dim TargetSheet As Worksheet
                Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
                SGCell.EntireRow.Copy Destination:=TargetSheet.Range("A" & TargetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1)
            Else
            End If
          Next
          If FoundCount = 0 Then MsgBox "No Record"
    End If
End Sub

By the way, about search value “52345”, are they numbers only & in column A only?

 

[Tom2020]

The problem with FindString still exists and it doesn’t work reliably, maybe because these cells have line breaks?
I can’t find all Search value “Call”
or
"No Record" for “after 2023”
"No Record" for “gifts this year”
"No Record" for “mrexcel”

>... numbers only & in column A only? Yes