This snippet displays the found search strings in a message box - Sheet and cell address.

How do I get the last line to put the found strings in individual cells on the sheet instead of all in K2 as it now does.

Thanks,
Howard


If bFoundID Then
sMsg = "The ID (" & sID & ") was found on the following sheets:"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & Join(Split(Mid(sIdShts, 2), ","), vbLf)
Else
sMsg = "ID not found"
End If
MsgBox sMsg

Range("K2") = Join(Split(Mid(sIdShts, 2), ","))

This snippet displays the found search strings in a message box -
Sheet and cell address.

How do I get the last line to put the found strings in individual
cells on the sheet instead of all in K2 as it now does.

Thanks,
Howard


If bFoundID Then
sMsg = "The ID (" & sID & ") was found on the following sheets:"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & Join(Split(Mid(sIdShts, 2), ","), vbLf)
Else
sMsg = "ID not found"
End If
MsgBox sMsg

Range("K2") = Join(Split(Mid(sIdShts, 2), ","))

While I fully understand what this code is doing.., I do not understand
the 'why' when you want to output to a range of cells. It would make
more sense to load the found IDs into an array, then 'dump' the array
into the worksheet.

As is, you could 'Split' sIdShts into a variant, then resize the target
cell...

vDataOut = Split(Mid(sIdShts, 2), ",")
Range("K2").Resize(1, lbound(vDataOut) + 1) = vDataOut

OR

Range("K2").Resize(lbound(vDataOut) + 1, 1) = _
Application.Transpose(vDataOut)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Oops..!

vDataOut = Split(Mid(sIdShts, 2), ",")
Range("K2").Resize(1, UBound(vDataOut) + 1) = vDataOut

OR

Range("K2").Resize(UBound(vDataOut) + 1, 1) = _
Application.Transpose(vDataOut)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Here is the whole macro, which is an enhanced version by you of something I wrote.

To start I just wanted it to list the found strings sheet and cell address on the summary sheet with (or without) the message box.

Where the final goal is to use a list on summary sheet (instead of an input box) that holds a number of search strings and take them one at a time and do the workbook search for each search string making a list of the sheets each search string was found on.

abc123 sheets 3, 6, 9
qwe456 sheets 2, 4, 6, 7
www987 "not found"

So the array caper looks like the way to go where the search strings are read into an array and the found string sheets names are into another and then dumped onto the summary sheet as a list.

If that make sense to you then I will give that a go to see if I can put it together, and if I get hung up, will post back for some guidance.

Howard

Sub FindSheetsWithID()
'/ my code polished by Garry
' Looks for an ID on all sheets except "Sheet1",
' and Msgbox the result of the search.

Dim ws As Worksheet, Rng As Range
Dim sID$, sIdShts$, sMsg$, vDataOut$
Dim bFoundID As Boolean

sID = InputBox("Enter a Client ID numbet")
If Trim(sID) = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet1" Then
Set Rng = ws.UsedRange.Find(What:=sID, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If Not Rng Is Nothing Then
bFoundID = True

sIdShts = sIdShts & ",'" & ws.Name & "'!" & Rng.Address

End If
End If
Next ws

If bFoundID Then
sMsg = "The ID (" & sID & ") was found on the following sheets:"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & Join(Split(Mid(sIdShts, 2), ","), vbLf)
Else
sMsg = "ID not found"
End If

MsgBox sMsg
End Sub

Hi Howard,

Am Wed, 25 Jun 2014 17:55:55 -0700 (PDT) schrieb L. Howard:

How do I get the last line to put the found strings in individual cells on the sheet instead of all in K2 as it now does.

write the matches in an array at once.
Try following code. The matches will be written in Sheet(1).

Sub FindSheetsWithID()

Dim wsh As Worksheet, c As Range
Dim strID As String, FirstAddress As String
Dim arrIn() As Variant, arrOut As Variant, myDic As Object
Dim n As Long, i As Long, LRow As Long

strID = InputBox("Enter a Client ID numbet")
If Trim(strID) = "" Then Exit Sub

For Each wsh In ThisWorkbook.Sheets
If Not wsh.Name = "Sheet1" Then
Set c = wsh.UsedRange.Find(What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
ReDim Preserve arrIn(n)
arrIn(n) = wsh.Name
n = n + 1
Set c = wsh.UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End If
Next

If n 0 Then
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(arrIn) To UBound(arrIn)
myDic(arrIn(i)) = arrIn(i)
Next
arrOut = myDic.items
End If


With Sheets(1)
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
If n 0 Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1).Resize(columnsize:=myDic.Count) = arrOut
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = "Not found"
End If
End With

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 26 Jun 2014 08:17:15 +0200 schrieb Claus Busch:

write the matches in an array at once.
Try following code. The matches will be written in Sheet(1).

better try:

Sub FindSheetsWithID()

Dim wsh As Worksheet, c As Range
Dim strID As String, FirstAddress As String, strOut As String
Dim arrIn() As Variant, arrOut As Variant, myDic As Object
Dim n As Long, i As Long, LRow As Long

strID = InputBox("Enter a Client ID numbet")
If Trim(strID) = "" Then Exit Sub

For Each wsh In ThisWorkbook.Sheets
If Not wsh.Name = "Sheet1" Then
Set c = wsh.UsedRange.Find(What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
ReDim Preserve arrIn(n)
arrIn(n) = Replace(wsh.Name, "Sheet", "")
n = n + 1
Set c = wsh.UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End If
Next

If n 0 Then
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(arrIn) To UBound(arrIn)
myDic(arrIn(i)) = arrIn(i)
Next
arrOut = myDic.items
strOut = Join(arrOut, ",")
End If


With Sheets(1)
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
If n 0 Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = strOut
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = "Not found"
End If
End With

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Regards

Claus B.

--


Thanks Claus, that is a nice jump start.

Howard

Here is the whole macro, which is an enhanced version by you of
something I wrote.

To start I just wanted it to list the found strings sheet and cell
address on the summary sheet with (or without) the message box.

Yes, I recall this! There was no intent to write to a worksheet and so
makes sense that there's no reason to build an output array. Now that
your intent has changed.., so must the code to suit. Claus has replied
with a good example of how to do it! (Though I'm curious about the use
of Scripting.Dictionary)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Am Thu, 26 Jun 2014 03:20:39 -0400 schrieb GS:

Here is the whole macro, which is an enhanced version by you of
something I wrote.

To start I just wanted it to list the found strings sheet and cell
address on the summary sheet with (or without) the message box.

Yes, I recall this! There was no intent to write to a worksheet and so
makes sense that there's no reason to build an output array. Now that
your intent has changed.., so must the code to suit. Claus has replied
with a good example of how to do it! (Though I'm curious about the use
of Scripting.Dictionary)


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Garry,

Am Thu, 26 Jun 2014 03:20:39 -0400 schrieb GS:

Though I'm curious about the use of Scripting.Dictionary

to avoid the output like 2,2,2,3,3,3,3,3,4if he has more than one match
in a sheet.
With Scripting.Dictionary he get unique values and the output is
2,3,4


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Garry,

Am Thu, 26 Jun 2014 03:20:39 -0400 schrieb GS:

Though I'm curious about the use of Scripting.Dictionary

to avoid the output like 2,2,2,3,3,3,3,3,4if he has more than one
match in a sheet.
With Scripting.Dictionary he get unique values and the output is
2,3,4


Regards
Claus B.

Yes, I understand. I thought the IDs were already a unique list and so
duplicates are not an issue. Though I suppose more than 1 instance of
any ID is possible. I might be inclined to go with building a string
conditional on found IDs not already InStr(), then Split to an output
array as I exampled (2nd post). Your way might be faster, though,
because building a conditional string tests every found ID before
adding it!<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry, hi Howard,

Am Thu, 26 Jun 2014 09:26:42 +0200 schrieb Claus Busch:

to avoid the output like 2,2,2,3,3,3,3,3,4if he has more than one match
in a sheet.
With Scripting.Dictionary he get unique values and the output is
2,3,4

oops, if I don't use FindNext I don'T have to create unique values.

Better try:

Sub FindSheetsWithID()

Dim wsh As Worksheet, c As Range
Dim strID As String, strOut As String
Dim LRow As Long

strID = InputBox("Enter a Client ID numbet")
If Trim(strID) = "" Then Exit Sub

For Each wsh In ThisWorkbook.Sheets
If Not wsh.Name = "Sheet1" Then
Set c = wsh.UsedRange.Find(What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then
strOut = strOut & wsh.Index & ", "
End If
End If
Next

With Sheets(1)
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(strOut) 0 Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = Left(strOut, Len(strOut) - 2)
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = "Not found"
End If
End With

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

oops, if I don't use FindNext I don'T have to create unique values.

Yes, that's better so long as the number found per ID doesn't matter.
(I initially didn't think there needed to be FindNext once found)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Thursday, June 26, 2014 12:46:04 AM UTC-7, GS wrote:
oops, if I don't use FindNext I don'T have to create unique values.



Hi Claus, Garry,

Here is as far as I have gotten, which will correctly return only the first strID on the first sheet looked at(Sheet 2, column G, G2).

This only worked after I commented out the "Set c...FindNext" which was throwing an error.

Some additional info of what I am shooting for.

Each of the two sheets in the array have a list in column G.

I want to go down that list on sheet 2 and post the returns on sheet "Instructions", then go down the list on sheet 3, column G and post the return on sheet "Instructions".

I am only using two sheets, but there may be around ten sheets + / - in real life.

My posted code here is modified from your first code suggestion. And I notice the Find Next is also in that commented out line.

I'll take a look at the second code, maybe I can make it return more than just one strID.

Howard


Sub ListSheetsWithstrID()

Dim wsh As Worksheet, c As Range, rngG As Range, strID As Range

Dim FirstAddress As String, strOut As String

Dim arrIn() As Variant, arrOut As Variant, myDic As Object

Dim n As Long, i As Long, j As Long, LRow As Long

Dim MyArr As Variant

MyArr = Array("Sheet2", "Sheet3")

Application.ScreenUpdating = False

For j = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))

Set rngG = .Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row)

For Each c In rngG

For Each wsh In ThisWorkbook.Sheets

If Not wsh.Name = "Instructions" Then

Set strID = wsh.UsedRange.Find(What:=c, _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not c Is Nothing Then

FirstAddress = c.Address

Do

ReDim Preserve arrIn(n)

arrIn(n) = Replace(wsh.Name, "Sheet", "")

n = n + 1

'Set c = wsh.UsedRange.FindNext(c)

Loop While Not c Is Nothing And c.Address < FirstAddress

End If ' not c

End If ' not wsh.name

Next ' wsh

Next ' c

End With ' myArr

Next 'j

If n 0 Then
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(arrIn) To UBound(arrIn)
myDic(arrIn(i)) = arrIn(i)
Next ' i
arrOut = myDic.items

strOut = Join(arrOut, ",")

End If

With Sheets("Instructions") 'Sheets(1)
LRow = .Cells(Rows.Count, "A").End(xlUp).Row

If n 0 Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = strOut
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = "Not found"
End If

End With

End Sub

Hi Howard,

Am Thu, 26 Jun 2014 04:01:54 -0700 (PDT) schrieb L. Howard:

Each of the two sheets in the array have a list in column G.

I want to go down that list on sheet 2 and post the returns on sheet "Instructions", then go down the list on sheet 3, column G and post the return on sheet "Instructions".

I am only using two sheets, but there may be around ten sheets + / - in real life.

what output do you expect? The match address?
Then try:

Sub FindSheetsWithID()

Dim wsh As Worksheet, c As Range
Dim strID As String, FirstAddress As String, strOut As String
Dim LRow As Long, i As Long
Dim StrShN As String
Dim myArr As Variant

strID = InputBox("Enter a Client ID numbet")
If Trim(strID) = "" Then Exit Sub

myArr = Array("Sheet2", "Sheet3")
For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))
strOut = ""
StrShN = .Name
Set c = .Range("G:G").Find(What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If strOut = "" Then
strOut = StrShN & " " & c.Address(0, 0) & ", "
Else
strOut = strOut & c.Address(0, 0) & ", "
End If
Set c = .Range("G:G").FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End With

With Sheets("Instructions")
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(strOut) Len(StrShN) Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = Left(strOut, Len(strOut) - 2)
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = StrShN & " Not found"
End If
End With
Next
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Each of the two sheets in the array have a list in column G.



I want to go down that list on sheet 2 and post the returns on sheet "Instructions", then go down the list on sheet 3, column G and post the return on sheet "Instructions".



I am only using two sheets, but there may be around ten sheets + / - in real life.



what output do you expect? The match address?



Hi Claus,

I want to eliminate the InPutBox and have the code go to column G on each sheet in turn and process each sheets column G entries with the return to be like this:

Column G entries examples:

abc123
def456
ghi789

And the Instructions sheet returns like this:

abc123 2, 3
def456 3
ghi789 Not Found

Whe
abc123 was found on sheet2 and sheet3.
def456 was found only on sheet3.
ghi789 was not on any sheet.

The number of times abc123 etc. occurs on any sheet does not matter, just what sheet it was found on.

Howard

I'm not following the logic of returning c.Address! This approach makes
more sense to me...


Option Explicit

Sub FindSheetsWithID_2()
' Looks for an ID on all sheets with search tag,
' and outputs results to summary sheet named "Instructions".

Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sID$, sOut$, sAddr1$
Dim bFoundID As Boolean, lCount&, vDataOut

sID = InputBox("Enter a Client ID")
If Trim(sID) = "" Then Exit Sub

'If we got here then initialize sOut
sOut = sID

On Error GoTo Cleanup
Set wksTarget = ThisWorkbook.Sheets("Instructions")
wksTarget.Activate

For Each Wks In ThisWorkbook.Worksheets
'Comment out next line to include all sheets
If bNameExists("MyTag", Wks) Then

sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range("G:G")
Set rng = .Find(What:=sID, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address
End If
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End With 'Wks.Range("G:G")
sOut = sOut & lCount: lCount = 0

'Comment out next line to include all sheets
End If 'bNameExists
Next 'Wks

'Output to worksheet
vDataOut = Split(sOut, ",")
'Next line assumes 1st row contains headings,
'or data already exists.
With wksTarget.Cells(Rows.Count, "A").End(xlUp)(2)
.Resize(1, UBound(vDataOut) + 1) = vDataOut
End With

Cleanup:
Set wksTarget = Nothing: Set rng = Nothing
End Sub

Function bNameExists(sName$, Wks As Worksheet) 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 = Wks.Names(sName): bNameExists = (Err = 0)
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Thu, 26 Jun 2014 09:16:10 -0700 (PDT) schrieb L. Howard:

I want to eliminate the InPutBox and have the code go to column G on each sheet in turn and process each sheets column G entries with the return to be like this:

the write the IDs in an array.
Try:

Sub FindSheetsWithID()
Dim c As Range
Dim strID As String, strOut As String
Dim LRow As Long, i As Long, j As Long
Dim myArr As Variant, arrID As Variant

strID = "abc123,def456,ghi789"
arrID = Split(strID, ",")

myArr = Array("Sheet2", "Sheet3")
For j = LBound(arrID) To UBound(arrID)
strOut = ""
For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))
Set c = .Range("G:G").Find(What:=arrID(j), _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then
strOut = strOut & Replace(Sheets(myArr(i)).Name,
"Sheet", "") & ", "
Set c = .Range("G:G").FindNext(c)
End If
End With
Next

With Sheets("Instructions")
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(strOut) 0 Then
.Range("A" & LRow + 1) = arrID(j)
.Range("B" & LRow + 1) = Left(strOut, Len(strOut) - 2)
Else
.Range("A" & LRow + 1) = arrID(j)
.Range("B" & LRow + 1) = "Not found"
End If
End With
Next
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

How/where does code find/get the IDs?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Better...



Sub FindSheetsWithID_v3()
' Looks for an ID on all sheets with search tag,
' and outputs results to summary sheet named "Instructions".
' Note: The search tag is a local scope defined name range
' that contains the search data column address.

Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sID$, sOut$, sAddr1$
Dim bFoundID As Boolean, lCount&, vDataOut

sID = InputBox("Enter a Client ID")
If Trim(sID) = "" Then Exit Sub

'If we got here then initialize sOut
sOut = sID

On Error GoTo Cleanup
Set wksTarget = ThisWorkbook.Sheets("Instructions")
wksTarget.Activate

For Each Wks In ThisWorkbook.Worksheets
'Comment out next line to include all sheets
If bNameExists("MyTag", Wks) Then
sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range("MyTag")
Set rng = .Find(What:=sID, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address: bFoundID = True
End If
If bFoundID Then
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End If 'bFoundID
End With 'Wks.Range("G:G")
sOut = sOut & lCount: lCount = 0

'Comment out next line to include all sheets
End If 'bNameExists
Next 'Wks

'Output to worksheet
vDataOut = Split(sOut, ",")
'Next line assumes 1st row contains headings,
'or data already exists.
With wksTarget.Cells(Rows.Count, "A").End(xlUp)(2)
.Resize(1, UBound(vDataOut) + 1) = vDataOut
End With

Cleanup:
Set wksTarget = Nothing: Set rng = Nothing
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

Note that for this v3 code to work on all sheets, the defined name
*must exist* on all sheets!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Better yet...

Sub FindSheetsWithID_v4()
' Looks for an ID on all sheets with search tag,
' and outputs results to summary sheet named "Instructions".
' Note: The search tag is a local scope defined name range
' that contains the search data column address.

Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sID$, sOut$, sAddr1$
Dim bFoundID As Boolean, lCount&, vDataOut

sID = InputBox("Enter a Client ID")
If Trim(sID) = "" Then Exit Sub

'If we got here then initialize sOut
sOut = sID
Const sRngToSearch$ = "MyTag" '//edit to suit

On Error GoTo Cleanup
Set wksTarget = ThisWorkbook.Sheets("Instructions")
wksTarget.Activate '//to view results

For Each Wks In ThisWorkbook.Worksheets
'Comment out next line to include all sheets
If bNameExists(sRngToSearch, Wks) Then
sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range(sRngToSearch)
Set rng = .Find(What:=sID, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address: bFoundID = True
End If
If bFoundID Then
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End If 'bFoundID
End With 'Wks.Range(sRngToSearch)
sOut = sOut & lCount: lCount = 0

'Comment out next line to include all sheets
End If 'bNameExists
Next 'Wks

'Output to worksheet
vDataOut = Split(sOut, ",")
'Next line assumes 1st row contains headings,
'or data already exists.
With wksTarget.Cells(Rows.Count, "A").End(xlUp)(2)
.Resize(1, UBound(vDataOut) + 1) = vDataOut
End With

Cleanup:
Set wksTarget = Nothing: Set rng = Nothing
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

On Thursday, June 26, 2014 10:18:37 AM UTC-7, GS wrote:
Note that for this v3 code to work on all sheets, the defined name

*must exist* on all sheets!



--

Garry


I think I need to back up a bit and restate where I am with all these codes.

This code below does EXACTLY what I am looking for with the exception of instead of an InputBox I want the code to go to the column G lists on each sheet (but not sheet "Instructions") and process the entries with a single click of the button.

Howard

Sub FindSheets_X()

Dim wsh As Worksheet, c As Range

Dim strID As String, strOut As String
Dim LRow As Long

strID = InputBox("Enter a Client ID numbet")
If Trim(strID) = "" Then Exit Sub

For Each wsh In ThisWorkbook.Sheets
If Not wsh.Name = "Instructions" Then
Set c = wsh.UsedRange.Find(What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then

strOut = strOut & wsh.Index & ", "

End If
End If
Next

With Sheets("Instructions")
LRow = .Cells(Rows.Count, "A").End(xlUp).Row

If Len(strOut) 0 Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = Left(strOut, Len(strOut) - 2)
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = "Not found"
End If
End With

End Sub

Like I asked before.., how/where does the code find/get the IDs to
search for? IOW, (1st & foremost) they must be available to code by
some method!

Also, you've reverted back to using UsedRange which will take longer
depending on its size. Meanwhile, I've been working toward something
more 'reliable' for results from entering only 1 ID. Not a problem to
do several IDs using arrays, but I recommend a 2D output array to
avaoid limitations of the Transpose() function (should that happen)!

I like the idea of giving the search range a local defined name because
if its RefersTo uses absolute refs then its location auto-adjusts when
columns are inserted/deleted. That means it doesn't need to be the same
column index on every sheet being searched, AND the search can be
limited to only sheets with that named range!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Thu, 26 Jun 2014 10:41:27 -0700 (PDT) schrieb L. Howard:

This code below does EXACTLY what I am looking for with the exception of instead of an InputBox I want the code to go to the column G lists on each sheet (but not sheet "Instructions") and process the entries with a single click of the button.

please have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "FindSheets"

In sheet "Instructions" you write in A1:An your IDs to search. Then
press button, The sheets indices will be written in column B


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 26 Jun 2014 10:41:27 -0700 (PDT) schrieb L. Howard:

This code below does EXACTLY what I am looking for with the
exception of instead of an InputBox I want the code to go to the
column G lists on each sheet (but not sheet "Instructions") and
process the entries with a single click of the button.

please have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "FindSheets"

In sheet "Instructions" you write in A1:An your IDs to search. Then
press button, The sheets indices will be written in column B


Regards
Claus B.

Claus,
Your example assumes that "Instructions" contains no instructions,
which is why I asked Howard to state where/how code gets the IDs. Also,
the sample doesn't split the results to separate columns which (I
believe) Howard wants done.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Claus,

Your example assumes that "Instructions" contains no instructions,

which is why I asked Howard to state where/how code gets the IDs. Also,

the sample doesn't split the results to separate columns which (I

believe) Howard wants done.



--

Garry

Hi Garry, Claus,

I believe the name of the sheet "Instructions" is a poor choice. May be better served to consider that name the same as "Summary" or "mySheet" and not a sheet to look to for "How to..."

The OP may indeed intend to use it as a formal Instructions sheet, but I am considering it simple a sheet with a name where the results go.

Claus, your last suggestion looks to me like it gets it done. It is not a loop through all the columns G on each search sheet but the results are certainly positive.

Garry, Id like to try you last suggestion, but am lost as to what or how that named range should look like.

Howard

Garry, Id like to try you last suggestion, but am lost as to what or
how that named range should look like.

This v5 uses a comma delimited list stored in a cell named "IdList" on
"Instructions". It creates an array of arrays for all IDs listed on the
'tagged' sheets, then converts that to a 1-based 2D array to 'dump'
into "Instructions" on the next empty row.

Note that any all-numeric IDs return as numeric data (not as text) and
so requires formatting ColA if you want the results for numeric IDs
displayed as text. Complete code follows..



Sub FindSheetsWithID_v5()
' Looks for an ID on all sheets with search tag,
' and outputs results to summary sheet named "Instructions".
' Note: The search tag is a local scope defined name range
' that contains the search data column address.

Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sID$, sOut$, sAddr1$, lCount&, n&, vData

Const sRngToSearch$ = "MyTag" '//edit to suit

Set wksTarget = ThisWorkbook.Sheets("Instructions")
'Assume comma delimited ID list stored in named range
With wksTarget
.Activate: sID = .Range("IdList").Text
End With
If Trim(sID) = "" Then Exit Sub

On Error GoTo Cleanup
vData = Split(sID, ","): ReDim vDataOut(UBound(vData))
For n = LBound(vData) To UBound(vData)
sOut = vData(n): sID = sOut
For Each Wks In ThisWorkbook.Worksheets
If bNameExists(sRngToSearch, Wks) Then
sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range(sRngToSearch)
Set rng = .Find(What:=sID, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End If 'Not rng Is Nothing
End With 'Wks.Range(sRngToSearch)
sOut = sOut & lCount: lCount = 0
End If 'bNameExists
Next 'Wks
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

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

Hi Garry,

This IdList has me stumped. I am not understanding how to make that list.


.Activate: sID = .Range("IdList").Text

Once it exists, I presume it holds all the items that are to be looked up on all the sheets. So instead of looping through the columns G on each sheet, the code can refer to the elements within that named range for the search items??

Howard

Hi Garry,

This IdList has me stumped. I am not understanding how to make that
list.


.Activate: sID = .Range("IdList").Text

Once it exists, I presume it holds all the items that are to be
looked up on all the sheets. So instead of looping through the
columns G on each sheet, the code can refer to the elements within
that named range for the search items??

Howard

In A1 on "Instructions":
Type abc123,def456,ghi789

In the namebox (left of FormulaBar):
With A1 selected:
Type instructions!IdList and hit 'Enter'

Run the code as posted if you've added named ranges for the search
columns. Otherwise, add those names on each sheet that contains search
data, then run the code. Optionally (not recommended), modify the code
to use UsedRange.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

To name the search cols on each sheet...

Select the col

In the namebox type
'sheet name'!MyFlag
(or whatever name you want to use)
hit the 'Enter' key

...and be sure to update the const value in the code to match whatever
name you use.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Unable to make the name ranges work for me so I put this together which pretty much does what I want.

Problem I have with this code is I want to consider the columns have headers on all the G columns and the A and B column in sheet Instructions.

The code lines I have commented out work ok without respect to headers and the code below the commented lines throw an error.

Can't figure why I can't use Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row) instead of G:G.

Howard


Sub G_Columns_To_One_Array()

Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

' Promt
strPrompt = " Do you want to clear Columns A and B " & vbCr & vbCr & _
" and process another set of Data?"

' Dialog's Title
strTitle = "Sheet Finder"

'Display MessageBox
iRet = MsgBox(strPrompt, vbYesNo, strTitle)

' Check pressed button
If iRet = vbNo Then
MsgBox "Okay, Good bye"
Exit Sub
Else
MsgBox "Yes! Let'er Rip!"
Sheets("Instructions").Range("A:B").ClearContents
End If


Dim lastRow As Long, lastRowDest As Long
Dim varSheets As Variant
Dim varOut As Variant
Dim i As Integer

Application.ScreenUpdating = False

varSheets = Array("Sheet2", "Sheet3")
lastRowDest = 1

For i = LBound(varSheets) To UBound(varSheets)
With Sheets(varSheets(i))
lastRow = .Range("G" & Rows.Count).End(xlUp).Row
varOut = .Range("G2:G" & lastRow)
Sheets("Instructions").Cells(lastRowDest, 1) _
.Resize(rowsize:=lastRow) = varOut
lastRowDest = Sheets("Instructions").Range("A" & Rows.Count) _
.End(xlUp).Row + 1
End With
Next

Find_What_Sheet
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Sub Find_What_Sheet()

Dim c As Range, wsh As Worksheet
Dim strID As String, strOut As String
Dim LRow As Long, i As Long
Dim arrID As Variant

With Sheets("Instructions")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row

'arrID = .Range("A1:A" & LRow) '/ maybe here?
arrID = .Range("A2:A" & LRow)

End With


For i = LBound(arrID) To UBound(arrID)
strOut = ""
For Each wsh In ThisWorkbook.Sheets
If wsh.Name < "Instructions" Then
With wsh

'Set c = .Range("G:G").Find(What:=arrID(i, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole)

'arrID(i, 1) = error 2042
Set c = .Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row).Find(What:=arrID(i, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not c Is Nothing Then
strOut = strOut & Replace(wsh.Name, "Sheet", "") & ", "
End If
End With
End If
Next

With Sheets("Instructions")
If Len(strOut) 0 Then
.Cells(i, 2) = Left(strOut, Len(strOut) - 2)
Else
.Cells(i, 2) = "Not found"
End If
End With
Next
End Sub

Unable to make the name ranges work for me...

This is pretty much a basic fundamental of VBA programming and so I
urge you to persist with patience!<g

Problem I have with this code is I want to consider the columns have
headers on all the G columns and the A and B column in sheet
Instructions.

Find() doesn't care about headers!

The code lines I have commented out work ok without respect to
headers and the code below the commented lines throw an error.

Can't figure why I can't use Range("G2:G" & Cells(Rows.Count,
7).End(xlUp).Row) instead of G:G.

I sent you my test file. Have a look at how names are used/work with
the v5 code I last posted here.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Final version follows for anyone interested...


Sub FindSheetsWithID_v6()
' Looks for an ID on all sheets with search tag,
' and outputs results to summary sheet named "Instructions".
' Note: The search tag is a local scope defined name range
' that contains the search data column address.

Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sOut$, sAddr1$, lCount&, n&, vData

Const sRngToSearch$ = "MyTag" '//edit to suit

Set wksTarget = ThisWorkbook.Sheets("Instructions")
'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 bNameExists(sRngToSearch, Wks) Then
sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range(sRngToSearch)
Set rng = .Find(What:=vData(n), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End If 'Not rng Is Nothing
End With 'Wks.Range(sRngToSearch)
sOut = sOut & lCount: lCount = 0
End If 'bNameExists
Next 'Wks
vDataOut(n) = Split(vData(n) & "|" & Mid$(sOut, 2), "|")
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

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

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:=UBoun d(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