Extract matched data from a table to another worksheet in Excel VBA - excel

Question

I've got a sample table in Sheet1 as below:
Location Model Part #
BF03 200W 40536573
BF04 200W 40536573
CV01 120W 40536585
CV02 135W 20085112
CV03 900W 20349280
CV04 135W 20085112
As a reference data of BF03 is in cell B6.
What I need it to do is:
A) When user typed part number (ex: 40536573) in Sheet3 say cell A1, only the matched location will be picked up
B) The picked up "location" value will be tabulated in Sheet2 starting from cell A6.
The output will look something like this:
Location Model Part #
BF03 200W 40536573
BF04 200W 40536573
To make matter more complicated, I would then need to have the "Location" data to be concatenated into a string and store it in Sheet 2 Cell A2.
I'm guessing we need to do a For Loop count rows but I couldn't get any reference on how to write it properly.
Below are what my error "OVERFLOW" code looks like
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FindMatch As String
Dim Rng As Range
Dim counter As Integer
counter = ActiveWorkbook.Worksheets("Sheet2").Range("A6", Worksheets("Sheet2").Range("A6").End(xlDown)).Rows.Count
For i = 6 To counter
'Get the value from other sheet set as FindMatch
FindMatch = Sheets("Sheet3").Cell("A1").Value
'Find each row if matches the desired FindMatch
If Trim(FindMatch) <> "" Then
With Sheets("Sheet2").Range("D" & i).Rows.Count
Set Rng = .Find(What:=FindMatch, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'copy the values required to the cell
Cells(i, 2) = Sheets("Sheet2").Cells(Rng.Row, 2)
Else
MsgBox "Nothing found"
End If
End With
End If
Next i
End Sub

Answer 1

Instead of using the .find method, I managed to use a simple for loop. Sometimes you need to think simple i guess :) I have also added a small function to clear previously used fields. If you check and give feedback if you face any problem, we can try to fix it.
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim S_Var As String
Dim copyRange As Range
Dim ws1_lastrow As Long
Dim ws2_lastrow As Long
Dim searchresult As Range
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
S_Var = ws3.Range("A1").Value
ws1_lastrow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
Set copyRange = ws1.Range("A1:C" & ws1_lastrow)
'Clear Data
ws2.Range("A2").Value = ""
If Range("A7").Value <> "" Then
ws2.Range("A7:C" & ws2.Range("A" & ws1.Rows.Count).End(xlUp).Row).Value = ""
End If
'Searchin through the sheet1 column1
For i = 2 To ws1_lastrow
If ws1.Range("C" & i) = S_Var Then
ws2_lastrow = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
ws1.Range("A" & i & ":C" & i).Copy Destination:=ws2.Range("A" & ws2_lastrow + 1)
End If
Next
'Adding location to sheet2 A2 as string
ws2_lastrow = ws2.Range("A" & ws1.Rows.Count).End(xlUp).Row
For i = 7 To ws2_lastrow 'starting from 7, where location starts
If ws2.Range("A2").Value = "" Then
ws2.Range("A2").Value = ws2.Range("A" & i).Value
Else
ws2.Range("A2").Value = ws2.Range("A2").Value & "," & ws2.Range("A" & i).Value
End If
Next