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

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 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