How/where does code find/get the IDs?
Here's 2 different approach examples that return the desired results.
FindSheetsWithID_A
Uses IDs stored in a cell named "IdList" on the results sheet.
FindSheetsWithID_B
Uses IDs stored as a list in colA on the results sheet.
Output is returned to A:B, where B contains a delimited string of all
sheet indexes where each ID is found. For each ID not found, B contains
"Not found".
Both examples use a search range (local scope) named "MyTag" to
accommodate the search range not being the same column on all search
sheets.
Code...
Option Explicit
Sub FindSheetsWithID_A()
' Looks for specified IDs on all sheets except results sheet,
' and builds a delimited output string of all sheet indexes where
found.
' Specified IDs to search for are stored as a comma delimited list
' on the results sheet in a cell (local scope) named "IdList".
Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sOut$, n&, vData
' The range to search is a local scope defined name range.
Const sRngToSearch$ = "MyTag" '//edit to suit
Set wksTarget = ThisWorkbook.Sheets("Instructions") '//results sheet
'Assume comma delimited ID list stored in named range
With wksTarget
.Activate: vData = Split(.Range("IdList").Text, ",")
End With
If VarType(vData) < vbArray Then Exit Sub
On Error GoTo Cleanup
ReDim vDataOut(UBound(vData))
For n = LBound(vData) To UBound(vData)
sOut = ""
For Each Wks In ThisWorkbook.Worksheets
If Not Wks Is wksTarget And bNameExists(sRngToSearch, Wks) Then
With Wks.Range(sRngToSearch)
Set rng = .Find(What:=vData(n), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then sOut = sOut & "," & Wks.Index
End With 'Wks.Range(sRngToSearch)
End If 'Not wksTarget And bNameExists
Next 'Wks
If sOut = "" Then sOut = vData(n) & "|Not found" Else _
sOut = vData(n) & "|" & Replace(Mid$(sOut, 2), ",", ", ")
vDataOut(n) = Split(sOut, "|")
Next 'n
'Output to worksheet
Xform_1DimArrayOfArraysTo2D vDataOut
With wksTarget.Cells(Rows.Count, "A").End(xlUp)(2)
.Resize(UBound(vDataOut), UBound(vDataOut, 2)) = vDataOut
.EntireColumn.NumberFormat = "@"
End With
Cleanup:
Set wksTarget = Nothing: Set rng = Nothing
End Sub 'FindSheetsWithID_A
Sub FindSheetsWithID_B()
' Looks for specified IDs on all sheets except results sheet,
' and lists all sheet indexes where each ID is found as a
' delimited output string. Specified IDs to search for are
' stored as a list in colA on the results sheet.
Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sOut$, n&, lStartNdx&, vData
Set wksTarget = ThisWorkbook.Sheets("Instructions") '//results sheet
'Assume comma delimited ID list stored in named range
With wksTarget
.Activate
vData = .Range("A1", .Cells(Rows.Count,
"A").End(xlUp)).Resize(ColumnSize:=2)
End With
If VarType(vData) < vbArray Then Exit Sub
'The range to search is a local scope defined name range.
Const sRngToSearch$ = "MyTag" '//edit to suit
'Accomodates if a header is included in vData
lStartNdx = IIf(vData(1, 1) = "Search IDs", 2, 1)
On Error GoTo Cleanup
For n = lStartNdx To UBound(vData)
sOut = ""
For Each Wks In ThisWorkbook.Worksheets
If Not Wks Is wksTarget And bNameExists(sRngToSearch, Wks) Then
With Wks.Range(sRngToSearch)
Set rng = .Find(What:=vData(n, 1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then sOut = sOut & "," & Wks.Index
End With 'Wks.Range(sRngToSearch)
End If 'Not wksTarget And bNameExists
Next 'Wks
vData(n, 2) = IIf(sOut = "", "Not found", Replace(Mid$(sOut, 2),
",", ", "))
' vData(n, 2) = sOut
Next 'n
'Output to worksheet
wksTarget.Range("IdList").Resize(ColumnSize:=UBound(vData, 2)) =
vData
Cleanup:
Set wksTarget = Nothing: Set rng = Nothing
End Sub 'FindSheetsWithID_B
Function bNameExists(sName$, oSource) As Boolean
' Checks if sName exists in oSource
' Arguments:
' sName The defined name to check for
' oSource A ref to the Wkb or Wks being checked
' Returns:
' True if name exists
Dim x As Object
On Error Resume Next
Set x = oSource.Names(sName): bNameExists = (Err = 0)
End Function
Sub Xform_1DimArrayOfArraysTo2D(Arr())
' Restructures a 1D 0-based dynamic array of arrays to a fixed 2D
1-based array
' Arguments:
' Arr() The array of arrays to be converted
'
Dim v1, vTmp(), lMaxCols&, lMaxRows&, n&, k&
If VarType(Arr) < vbArray Then Exit Sub
lMaxRows = UBound(Arr) + 1: vTmp = Arr: Erase Arr
'Get size of Dim2
For n = LBound(vTmp) To UBound(vTmp)
k = UBound(vTmp(n))
lMaxCols = IIf(k + 1 > lMaxCols, k + 1, lMaxCols)
Next 'n
ReDim Arr(1 To lMaxRows, 1 To lMaxCols)
For n = LBound(vTmp) To UBound(vTmp)
For k = LBound(vTmp(n)) To UBound(vTmp(n))
Arr(n + 1, k + 1) = vTmp(n)(k)
Next 'k
Next 'n
End Sub
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
