PDA

View Full Version : multipage search - duplicate entries



bdsii
01-19-2010, 01:45 PM
Attached is a sample file with code. The code is also posted below.

I am attempting to combine select data from 3 tabs into a different Report tab.

- There are possible duplicate SearchInfo entries on the 3 tabs. A duplicate may be found on one or two tabs but could be a single line on the third. Each duplication should be entered on a separate line so that if the SearchInfo is found 3 times on one tab, there are three lines for that SearchInfo on the Report tab.

- There are tabs that the SearchInfo is not found and the code provides for the info that should be placed into the Report tab if that happens.

- There will be varying amounts of data that this code will have to handle.

The tab CurrentReportOutput shows the results of existing code.

I have tried to cobble together something workable and it is close but am still having trouble. I cannot get the report to display the duplicates on the Report tab. I also cannot get the default info to be entered onto the Report tab when the SearchInfo is not found.

I also have a section of code to check each tab but that likely is not the most efficient way to solve the problem.

I would like to stay close to the original code since I can understand the commands used in it rather than going down a totally different path but I am not sure that I can stay with this data.

I did not try it but it would also be useful if the code could handle some type of wildcard search for the field SearchInfo in the tabs. The Search data tab would have only the last 9 of the 13 characters found in the Data tabs as the SearchInfo field.


Any help or guidance would be appreciated. :help


thanks in advance !



Sub AAA_FindTest()

Dim lCount As Long
Dim rFoundCell As Range
Dim totalrows As Long
Dim SearchInfo As String
Dim LastRow As Long
Dim Count As Long
Dim Row As Long

Sheets("SearchData").Select
Range("A:A").Select
LastRow = ActiveSheet.UsedRange.Rows.Count

Count = 2

Do
Sheets("SearchData").Select
Range("A" & Count).Select
SearchInfo = Range("A" & Count).Value

Sheets("Data1").Select
totalrows = ActiveSheet.UsedRange.Rows.Count
Range("A7:A" & totalrows).Select

Set rFoundCell = Range("A7: A" & totalrows)
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchInfo)
Set rFoundCell = Cells.Find(What:=SearchInfo, After:=Range("A1"), LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If rFoundCell Is Nothing Then
Sheets("Report").Activate
Range("A" & Count).Value = SearchInfo

Else
rFoundCell.Activate
Row = rFoundCell.Row
Range("A" & Row & ":D" & Row).Select
Selection.Copy
Sheets("Report").Activate
Range("A" & Count).Select
ActiveSheet.Paste
End If

Next lCount

Count = Count + 1
Loop Until Count = LastRow + 1

' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

' Starts check for second sheet
Sheets("Report").Select
Range("A:A").Select
LastRow = ActiveSheet.UsedRange.Rows.Count
lCount = 1
Count = 2
Do

Sheets("Report").Select
Range("A" & Count).Select
SearchInfo = Range("A" & Count).Value

Sheets("Data2").Select
totalrows = ActiveSheet.UsedRange.Rows.Count
Range("A7:A" & totalrows).Select

Set rFoundCell = Range("A7: A" & totalrows)
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchInfo)
Set rFoundCell = Cells.Find(What:=SearchInfo, After:=Range("A1"), LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If rFoundCell Is Nothing Then

Sheets("Report").Activate
Range("E" & Count).Value = "No Info from Data2"
Range("F" & Count).Value = "No Info from Data2"
Range("G" & Count).Value = "No Info from Data2"
Range("H" & Count).Value = "No Info from Data2"
Range("I" & Count).Value = "No Info from Data2"
Range("J" & Count).Value = "No Info from Data2"
Sheets("Data2").Select
Else


rFoundCell.Activate
Row = rFoundCell.Row
Range("B" & Row & ":G" & Row).Select
Selection.Copy
Sheets("Report").Activate
Range("E" & Count).Select
ActiveSheet.Paste
Sheets("Data2").Select
End If

Next lCount

Count = Count + 1
Loop Until Count = LastRow + 1

' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

' Starts check for third sheet
Sheets("Report").Select
Range("A:A").Select
LastRow = ActiveSheet.UsedRange.Rows.Count
lCount = 1
Count = 2


Do

Sheets("Report").Select
Range("A" & Count).Select
SearchInfo = Range("A" & Count).Value

Sheets("Data3").Select
totalrows = ActiveSheet.UsedRange.Rows.Count
Range("A7:A" & totalrows).Select

Set rFoundCell = Range("A7: A" & totalrows)
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchInfo)
Set rFoundCell = Cells.Find(What:=SearchInfo, After:=Range("A1"), LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If rFoundCell Is Nothing Then

Sheets("Report").Activate
Range("K" & Count).Value = "No Info from Data3"
Sheets("Data3").Select
Else


rFoundCell.Activate
Row = rFoundCell.Row
Range("C" & Row).Select
Selection.Copy
Sheets("Report").Activate
Range("K" & Count).Select
ActiveSheet.Paste
Sheets("Data3").Select
End If

Next lCount

Count = Count + 1
Loop Until Count = LastRow + 1

End Sub

bdsii
01-20-2010, 06:29 AM
any expert guidance out there ?