Having Trouble getting my code to run

[ChrisFH]

Hello all! I am trying to figure out a way to read a cell in worksheet A, search for the string in worksheet B and then copy that whole row to worksheet C. I am missing something and I keep tweaking the code and feel like I am making it worse and worse so I am going to post what I have and hopefully someone can help!

Private Sub CommandButton1_Click()
Dim c As Range
Dim d As Range
Dim Source As Worksheet
Dim Target As Worksheet
Dim Data As Worksheet
Dim LSearchRadio As Integer
Dim LCopyToRadio As Integer
Dim LRadioString As String
Dim LRadioCounter As Integer
' Change worksheet designations as needed
Set Data = Me.Parent.Worksheets("SysData")
Set Source = Me.Parent.Worksheets("Report")
Set Target = Me.Parent.Worksheets("Radio")

'Start search in row 2
LSearchRadio = 2
'Start copying data to row 1 in Radio (row counter variable)
LCopyToRadio = 2

'Start the Radio Counter
LRadioCounter = 2


For Each c In Data.Range("A1:A3") ' Do 1000 rows in SysData for Radio
With c.Value = True

'Copy the next TAM
LRadioString = Range(Data.["A"] & CStr(LRadioCounter)).Value

Do While Range(Data.["A"] & CStr(LRadioCounter)).Value <> "" ' Do rows in Report

Source.Select

'If value in Report Worksheet on column M = String From SysData, copy entire row to Radio
If Range(Source.["M"] & CStr(LSearchRadio)).Value = LRadioString Then
'Select row in Report to copy
Source.Select
Source.Rows(CStr(LSearchRadio) & ":" & CStr(LSearchRadio)).Select
Selection.Copy

'Paste row into Radio in next row
Target.Select
Target.Rows(CStr(LCopyToRadio) & ":" & CStr(LCopyToRadio)).Select
Target.Paste

'Move counter to next row
LCopyToRadio = LCopyToRadio + 1
'Go back to Report to continue searching


'End if for Copy
End If


LSearchRadio = LSearchRadio + 1


Loop


'Goto next TAM on SysData for Radio
LRadioCounter = LRadioCounter + 1

End With
Next c

End Sub

 

[My Aswer Is This]

My script looks for the search string in Range("A1") of Sheet(1)
My script searches Column (A) of Sheet(2) for the search string
My Script then copies that row to Sheet(3)
Modify to your needs.

Sub My_Find_New()
'Modified 6/11/18 2:00 AM EDT
Dim SearchString As String
Dim SearchRange As Range
Dim Lastrow As Long
Lastrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
Dim ans As Variant
ans = Sheets(1).Range("A1").Value
SearchString = ans
Set SearchRange = Sheets(2).Range("A2:A" & Lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox ans & "  Not Found": Exit Sub
ans = SearchRange.Row
Sheets(2).Rows(ans).Copy Sheets(3).Rows(2)
End Sub

 

[ChrisFH]

Is there a way to make the ans count up after it has finished with copying all of the data from sheet 2? The reason I had it in a loop is because I need to copy multiple lines of the that have the same code in it, then go onto the next code on Sheet 1 and copy and repeat. So it should take a string from sheet 1 and look for it on sheet 2, copy the row, paste in sheet 3, then go back to sheet 2, find the next one, copy that and past into sheet 3, ect. Once that is done I need it to go back to sheet 1 and read A2, the next string and repeat what it did with A1.

 

[dmt32]

Hi,
not sure if fully understood what you are trying to do but see if following goes in right direction

Private Sub CommandButton1_Click()
Dim Target As Worksheet
Dim Data As Variant, Item As Variant
Dim CopyRange As Range, c As Range, Source As Range


    With ThisWorkbook
        With .Worksheets("SysData")
'search values sheet1
            Data = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp)).Value2
        End With
        With .Worksheets("Report")
'search range sheet2
            Set Source = .Range(.Range("M2"), .Range("M" & .Rows.Count).End(xlUp))
        End With
'copy to destination sheet3
            Set Target = .Worksheets("Radio")
    End With
    
    For Each Item In Data
        For Each c In Source.Cells
        If UCase(c.Value) = UCase(Item) Then
            If CopyRange Is Nothing Then
                Set CopyRange = c
            Else
                Set CopyRange = Union(CopyRange, c)
            End If
        End If
    Next c
    
    If Not CopyRange Is Nothing Then
        CopyRange.EntireRow.Copy _
        Target.Cells(Target.Cells(Target.Rows.Count, "A").End(xlUp).Row + 1, 1)
    End If
'release object variable from memory
    Set CopyRange = Nothing
'next search item
    Next Item


End Sub

Solution is untested & will need to be adjusted to meet your specific project need as required.

Hope Helpful

Dave

 

[My Aswer Is This]

I used the sheets 1 2 and 3

Sheet 1 has the search values in range ("A1") then "A2" etc.
Sheet 2 is where we search column A for the search values.
Sheet 3 is where we copy the rows to.

Try this:
Run the script from sheet 1

Sub Filter_Me()
'Modified 6/11/18 8:30 AM EDT
Dim Lastrow As Long
Dim Lastrowa As Long
Dim LastrowM As Long
Dim c As Long
Dim s As Variant
LastrowM = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastrowM
c = "1" ' Column Number Modify this to your need
s = Sheets(1).Cells(i, 1).Value 'Saerch Value Modify to your need
Lastrow = Sheets(2).Cells(Rows.Count, c).End(xlUp).Row
Lastrowa = Sheets(3).Cells(Rows.Count, c).End(xlUp).Row + 1

With Sheets(2).Cells(1, c).Resize(Lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(3).Rows(Lastrowa)
    Else
        MsgBox "No  " & s & "  Value  found"
    End If
    .AutoFilter
End With
Next
End Sub

 

[ChrisFH]

I used the sheets 1 2 and 3

Sheet 1 has the search values in range ("A1") then "A2" etc.
Sheet 2 is where we search column A for the search values.
Sheet 3 is where we copy the rows to.

Try this:
Run the script from sheet 1

Sub Filter_Me()
'Modified 6/11/18 8:30 AM EDT
Dim Lastrow As Long
Dim Lastrowa As Long
Dim LastrowM As Long
Dim c As Long
Dim s As Variant
LastrowM = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastrowM
c = "1" ' Column Number Modify this to your need
s = Sheets(1).Cells(i, 1).Value 'Saerch Value Modify to your need
Lastrow = Sheets(2).Cells(Rows.Count, c).End(xlUp).Row
Lastrowa = Sheets(3).Cells(Rows.Count, c).End(xlUp).Row + 1

With Sheets(2).Cells(1, c).Resize(Lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(3).Rows(Lastrowa)
    Else
        MsgBox "No  " & s & "  Value  found"
    End If
    .AutoFilter
End With
Next
End Sub

dmt32, Your code for some reason didn't run at all? Not sure why, I combed through it. My Answer is this, your code worked amazingly! Thank you very much. I did have a question, there is another format the data comes in the list things like:

Info needed 1
Info needed 1a
Info needed 1b

Info needed 2
Info needed 2a
Info needed 2b

Is there a way to have it copy every row until a space? So the same exact thing your code does now, just copy multiple rows over and stop every space it hits, then search again?

V/R,
ChrisFH

 

[My Aswer Is This]

Are you saying you do not want the whole row copied over?

You just want column A B and C copied over?

If this is not what you want then please explain more.

I do not understand:

Is there a way to have it copy every row until a space?​

Where is this space?

 

[ChrisFH]

Are you saying you do not want the whole row copied over?

You just want column A B and C copied over?

If this is not what you want then please explain more.

I do not understand:

Is there a way to have it copy every row until a space?​

Where is this space?

No the whole row. You got it right. Now imagine the first 3 rows, then a space, then 5 more then a space then2 more then a space. All rows with an undetermined number then a space between the next item. If that makes sense

 

[My Aswer Is This]

Is this what you want:

Sub Filter_Me()
'Modified 6/11/18 11:15 PM EDT
Dim Lastrow As Long
Dim Lastrowa As Long
Dim LastrowM As Long
Dim c As Long
Dim s As Variant
LastrowM = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastrowM
c = "1" ' Column Number Modify this to your need
s = Sheets(1).Cells(i, 1).Value 'Saerch Value Modify to your need
Lastrow = Sheets(2).Cells(Rows.Count, c).End(xlUp).Row
Lastrowa = Sheets(3).Cells(Rows.Count, c).End(xlUp).Row + 2

With Sheets(2).Cells(1, c).Resize(Lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(3).Rows(Lastrowa)
    Else
        MsgBox "No  " & s & "  Value  found"
    End If
    .AutoFilter
End With
Next
End Sub

 

[dmt32]

dmt32, Your code for some reason didn't run at all? Not sure why, I combed through it.
ChrisFH

A little puzzled by that but no worries you seem to have found something that works for you

Dave.