Copying rows to new sheet with search function

[Srelie]

I am new to VBA and am in need of some help.

My goal is to copy rows to a new sheet, based on a search from a set list.

I found a macro via a google search earlier and tried to modify it to my needs, but I'm not competent enough yet.

Sub Search()
  'If value in column B = Matches anything in column G, copy entire row to Sheet2
  Dim searchTerm As String
  For I = 1 To 1130
      searchTerm = ActiveSheet.Range("G" & I).Text
      If ActiveSheet.Range("B" & CStr(LSearchColumn)).Value = searchTerm Then
         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy
         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste
         'Move counter to next row
         LCopyToRow = LCopyToRow + 1
         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select
      End If
Next I
End Sub

I'm getting this error: Run-time error '1004'


Thank you.

 

[Srelie]

Here is an example from my workbook:

A	B	C	D	E	F	G
50115	100-050115-01	MK-100-050115-01-1	044-001-006			050001-
50205	100-050205-01	MK-100-050205-01-1	041-001-013			050002-
50309	100-050309-01	MK-100-050309-01-1	052-001-001			050004-
50309	100-050309-01	MK-100-050309-01-2	052-001-001			050101-
50309	100-050309-01	MK-100-050309-01-3	052-001-001			050102-
50309	100-050309-01	MK-100-050309-01-4	052-001-001			050103-
50309	100-050309-01	MK-100-050309-01-5	052-001-001			050107-
50309	100-050309-01	MK-100-050309-01-6	052-001-001			050108-
50309	100-050309-01	MK-100-050309-01-7	052-001-001			050111-
50309	100-050309-01	MK-100-050309-01-8	052-001-001			050114-

<tbody>
</tbody>

I want to be able to search through Column B by using the first value in Column G, then the second, third, etc...

When it finds match in Column B, the entire row would be copied and pasted into the next available row in the next sheet(named sheetPaste).

I did figure out how to initialize my variables, but still think I am in over my head with this. Searching manually, then copying and pasting will take forever and that is my motive for trying to make this macro.

Thank you.

 

[JoeMo]

From the data you posted in post #11, looks like you want a partial match. That is, if a G cell string is found within a B cell string you want the entire row of the B cell pasted to "sheetPaste". Assuming that's correct, the code below should work provided that you run it when the sheet containing the source data is the active sheet.

Sub Srelie()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Rs As Range, Rg As Range, Vs As Variant, Vg As Variant, S As String
Dim i As Long, j As Long, nxRw As Long
Set Sh1 = ActiveSheet
Set Sh2 = Sheets("sheetPaste")
With Sh1
    Set Rs = .Range("A1").CurrentRegion
    Vs = Rs.Value
    Set Rg = .Range("G1:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
    Vg = Rg.Value
End With
For i = 1 To UBound(Vg, 1)
    For j = 1 To UBound(Vs, 1)
        If Vs(j, 2) Like "*" & Vg(i, 1) & "*" Then S = S & "," & j & ":" & j
    Next j
Next i
If S <> "" Then
    Application.ScreenUpdating = False
    nxRw = IIf(IsEmpty(Sh2.Range("A1")), 1, Sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Sh1.Range(Right(S, Len(S) - 1)).Copy Destination:=Sh2.Rows(nxRw)
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
Else
    MsgBox "no matches of col G items found in col B"
End If
End Sub

 

[Srelie]

From the data you posted in post #11, looks like you want a partial match. That is, if a G cell string is found within a B cell string you want the entire row of the B cell pasted to "sheetPaste". Assuming that's correct, the code below should work provided that you run it when the sheet containing the source data is the active sheet.

Sub Srelie()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Rs As Range, Rg As Range, Vs As Variant, Vg As Variant, S As String
Dim i As Long, j As Long, nxRw As Long
Set Sh1 = ActiveSheet
Set Sh2 = Sheets("sheetPaste")
With Sh1
    Set Rs = .Range("A1").CurrentRegion
    Vs = Rs.Value
    Set Rg = .Range("G1:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
    Vg = Rg.Value
End With
For i = 1 To UBound(Vg, 1)
    For j = 1 To UBound(Vs, 1)
        If Vs(j, 2) Like "*" & Vg(i, 1) & "*" Then S = S & "," & j & ":" & j
    Next j
Next i
If S <> "" Then
    Application.ScreenUpdating = False
    nxRw = IIf(IsEmpty(Sh2.Range("A1")), 1, Sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Sh1.Range(Right(S, Len(S) - 1)).Copy Destination:=Sh2.Rows(nxRw)
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
Else
    MsgBox "no matches of col G items found in col B"
End If
End Sub

Thank you for the response!

You've described exactly what I am wanting to do. I tried running the code you posted, and get an error:

Run-time error '1004:
Method 'Range' of object '_Worksheet' failed

I've colored the line that broke red.

 

[JoeMo]

Thank you for the response!

You've described exactly what I am wanting to do. I tried running the code you posted, and get an error:

Run-time error '1004:
Method 'Range' of object '_Worksheet' failed

I've colored the line that broke red.

When the error occurs click Debug and mouse over the variable S in that line. What is the value of S?

 

[Srelie]

when the error occurs click debug and mouse over the variable s in that line. What is the value of s?

s=",11819:11819,11820:11820,11821:11821,..."

 

[JoeMo]

s=",11819:11819,11820:11820,11821:11821,..."

That looks ok assuming the .... isn't really there. Do you have a sheet named "sheetPaste" (w/o the quote marks)?

I've tested the code using just your posted data. There are no matches, but I've introduced a few to col B and the code works well for me.

 

[Srelie]

That looks ok assuming the .... isn't really there. Do you have a sheet named "sheetPaste" (w/o the quote marks)?

I've tested the code using just your posted data. There are no matches, but I've introduced a few to col B and the code works well for me.

Yes, my sheet is named the same as in the code.

So, I tried it on a smaller scale and it worked just fine. After that I brought everything into a clean workbook that still worked with the small amount of values. But when I brought in the total of my information, it gives me a new error:

Run-time error '1004':
Application-defined or object-defined error

 

[JoeMo]

Yes, my sheet is named the same as in the code.

So, I tried it on a smaller scale and it worked just fine. After that I brought everything into a clean workbook that still worked with the small amount of values. But when I brought in the total of my information, it gives me a new error:

Run-time error '1004':
Application-defined or object-defined error

Always note on which line the error occurred. VBA error messages are not very informative, especially if you don't know the line that evoked the message. Which line produced that error?

 

[Srelie]

Always note on which line the error occurred. VBA error messages are not very informative, especially if you don't know the line that evoked the message. Which line produced that error?

It's not giving me the debug option. I ran it again and got just a dialog that said "400". Now it is back to the normal error, though.

 

[JoeMo]

It's not giving me the debug option. I ran it again and got just a dialog that said "400". Now it is back to the normal error, though.

It's really difficult to diagnose problems w/o benefit of seeing your data or having someone who knows VBA on your end. If you will send me a Private Message I will reply with an email address to which you can send your workbook. Remove any sensitive data of course.