Hi, new to VBA, but I have a workbo 1

[smcgrath171]

Hi, new to VBA, but I have a workbook with multiple sheets (same format). I have code (pulled from multiple sites) to search and copy the row of data if string is found and loop. The issue is that in some cases two fields (G: and K might have the same string and I only want to copy row once. My current code copies twice and pastes to another sheet (Search). Been pulling my hair out...

 

[zelgar]

Odds are your macro is checking every cell in the row for the string. Depending on how you're checking all of the cells in the row, you'll either need to break out of the loop, redefine where you're at in the loop (e.g., if you're in the middle of the loop, change the code to think you've checked the last item in the loop); after you've made a match. Without seeing your code, it's hard to provide any additional assistance.

 

[smcgrath171]

Sorry, as I stated I just picked this all up be reading previous posts and have no background in VBA. here is the code and link to the actual workbook:

Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
Dim lastrow As Integer


Sheets("SEARCH").Range("A4:K1000").ClearContents


myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub


For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo myNext
If ws.Name = "Lists" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Found.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub

 

[zelgar]

I think the following change to your code will work (add the bold text):
after the Dim statements, add
lastrow = 0

Modify your line:
If Not Found Is Nothing And lastrow <> Found.Row Then
lastrow = Found.Row

Note: You still had data in Sheet1

 

[smcgrath171]

Thanks in advance; I made the changes (shown Below) and I get a Run-time error '91": Object variable or With block variable not set. I left fake data on sheet 1 if you wanted to test by searching by any field on the search tab.

Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
Dim lastrow As Integer
lastrow = 0

Sheets("SEARCH").Range("A4:K1000").ClearContents
myText = InputBox("Enter text to find")
If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo myNext
If ws.Name = "Lists" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not Found Is Nothing And lastrow <> Found.Row Then
lastrow = Found.Row

Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Found.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub

 

[zelgar]

The problem was having the "And lastrow <> Found.Row" in the IF statement would give an error when Found was empty. Therefore, we need to have another IF statement to check if the lastrow is equal to the Found.Row. Your original code needs to be changed to the following:

lastrow = 0

If Not Found Is Nothing Then
If lastrow <> Found.Row Then
.
.
.
End If
End If

 

[zelgar]

I also noticed a problem with your macro. You're coping the cells, as in the formula, of the cells to the new sheet. What you want is the data. You need to do a paste special, values. Here's the modified macro including the changes I mentioned earlier:

Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
Dim lastrow As Integer

lastrow = 0

Sheets("SEARCH").Range("A4:K1000").ClearContents


myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub


For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo myNext
If ws.Name = "Lists" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not Found Is Nothing Then
If lastrow <> Found.Row Then
lastrow = Found.Row
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Found.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial Paste:=xlPasteValues
End With

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub

 

[smcgrath171]

I appreciate all the help; I copied the above and ran it... it still copies a row twice if the search criteria is listed in two different cells of the same row (I would like it to find the first occurrence, copy and move to the next row). It also now only checks the first sheet where it did the entire workbook before? Again I can't tell you how much I appreciate as I have spent days looking at posts before I decided to post myself for help.

 

[smcgrath171]

I did some more testing with the workbook I posted as I put some data in sheets 1-5; example if I search for "Reddy" I only get sheet1 results, but if I search for "Delucia" I get results from sheet1 and sheet5 (none from the sheet2, 3, 4). I did a search by serial number (A: all sheets) and got results for Sheets 1, 2,5) even though its on all sheets? I checked my protections and they all seem the same per worksheet....

 

[zelgar]

I didn't notice that after finding the 1st item, you found all of the others within your DO loop . I needed to move the IF and End IF statements. I have revised code that hopefully works for all of the pages (it at least drops the duplicate lines as you originally requested):

Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
Dim lastrow As Integer

lastrow = 0

Sheets("SEARCH").Range("A4:K1000").ClearContents


myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub


For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo myNext
If ws.Name = "Lists" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
If lastrow <> Found.Row Then
lastrow = Found.Row
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Found.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial Paste:=xlPasteValues
End With
End If
Set Found = .UsedRange.FindNext(Found)


Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub

 

[smcgrath171]

Thank you!!!! It all works;-)

 

[SkipVought]

Please, when you post code, for the benefit of all, use the [tt][ignore]

....

[/ignore][/tt] TGML tags or the Code Icon above the Reply To This Thread Window: 4^th icon from right.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}