one search form loops through all sheets

[saban]

I have a search form that finds records in worksheet
But how is done to find records in all worksheets-(i have 20 of sheets and now I have to switch between them to look in each sheet separately, each sheet now has this form on it, and what I would like is to have one form on one sheet, and that form looks through all the sheets) in workbook

Thnx
saban

[Killian]

You can run your Find on each worksheet in turn with something likeDim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
With ws
'do find on worksheet object ws
.Cells.Find '(etc ...
'etc...
End With
Next ws

[saban]

thnx
I will give it a try

[gibbo1715]

This might help you on the way Gibbo

Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim All As Object
Dim Current As String
Current = ActiveSheet.Name
WhatToFind = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
If WhatToFind = False Then
End
End If
If WhatToFind <> "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
If MsgBox("Stop Search", vbInformation + vbYesNo) = vbYes Then
End
End If
On Error Resume Next
While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
If MsgBox("Stop Search", vbInformation + vbYesNo) = vbYes Then
End
End If
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If
MsgBox "All Records Searched"
Sheets(Current).Select
Range("A1").Select

[saban]

Set rCell = rRange.Columns(1).Find(What:=strFind1, After:=rCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

Is there a way to include somwhere here to look through all sheets?
Because I guess my form looks for rCell??

[saban]

If i write this:
Dim oSheet As Object
For Each oSheet In ActiveWorkbook.Worksheets
'search with form
next oSheet

It loops as many times as there are sheets but in one sheet it looks as many times as there are sheets in same sheet
Why??

[XLGibbs]

It loops as many times as there are sheets but in one sheet it looks as many times as there are sheets in same sheet
Why??


Huh?

Post the whole code you are currently using to perform the search ..

[saban]

Private Sub CommandButton1_Click()
'Procedure level variables
Dim lCount As Long
Dim lOccur As Long
Dim rCell As Range
Dim rCell2 As Range
Dim rCell3 As Range
Dim bFound As Boolean
Dim sestej As Long

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'do something

'Dim strfind4 As String
'At least one value, from ComboBox1 must be chosen
If strFind1 & strFind2 & strFind3 = vbNullString Then
MsgBox "Izbran ni bil noben kriterij", vbCritical
Exit Sub 'Go no further
ElseIf strFind1 = vbNullString Then
MsgBox "A value from " & Label1.Caption _
& " must be chosen", vbCritical
Exit Sub 'Go no further
End If

'Clear any old entries
On Error Resume Next
ListBox1.Clear
On Error GoTo 0

'If String variable are empty pass the wildcard character
If strFind2 = vbNullString Then strFind2 = "*"
If strFind3 = vbNullString Then strFind3 = "*"

'Set range variable to first cell in table.
Set rCell = rRange.Cells(1, 1)
'Pass the number of times strFind1 occurs
lOccur = WorksheetFunction.CountIf(rRange.Columns(1), strFind1)

'Loop only as many times as strFind1 occurs
For lCount = 1 To lOccur
'Set the range variable to the found cell. This is then also _
used to start the next Find from (After:=rCell)
Set rCell = rRange.Columns(1).Find(What:=strFind1, After:=rCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Check each find to see if strFind2 and strFind3 occur _
on the same row.
If rCell(1, 2) Like strFind2 And rCell(1, 4) Like strFind3 Then
bFound = True 'Used to not show message box for no value found.
'Add the address of the found cell and the cell on the _
same row but 2 columns to the right.

ListBox1.AddItem rCell.Value
ListBox1.List(ListBox1.ListCount - 1, 1) = rCell.Offset(0, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = rCell.Offset(0, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = rCell.Offset(0, 3).Value
ListBox1.List(ListBox1.ListCount - 1, 4) = rCell.Offset(0, 4).Value
ListBox1.AddItem rCell.Address & ":" & rCell(1, 3).Address

ListBox1.ControlTipText = "Dvoklikni na naslov celice in ne na besedilo (naslov :$A$2:$A$2)"
End If

If rCell(1, 2) Like strFind2 And rCell(1, 4) Like strFind3 Then
sestej = WorksheetFunction.Sum(rCell(1, 3)) + sestej
TextBox1.Text = sestej
End If
Next lCount

If bFound = False Then 'No match
MsgBox "Zapis s tem kriterijem ne obstaja", vbOKOnly
End If
Next ws
End Sub

Here is the code

[XLGibbs]

lOccur = WorksheetFunction.CountIf(rRange.Columns(1), strFind1)

'Loop only as many times as strFind1 occurs
For lCount = 1 To lOccur


Where is strFind1 defined as something?

If I understand your message correctly, it loops through every row possible selection that would populate strFind1 (as opposed to the countIF identified above)...which tells me that it is essentiall counting all occurrences.

I see nothing in the code that identifies several of your strings as having anything? are the strFind1 etc constants? how are they passed into this code?

[Killian]

More specifically, I think "rRange" may be the issue...
This seems to be the target range for the Find function, but if it's defined elsewhere it will always refer to the range of the sheet where it was set.
For the Find to happen on each sheet, it will need to be redefined for each sheet, inside the loop, e.g.
Set rRange = ws.Range("A1:A10")

[saban]

strfind1 = combobox1

ok I will try it and let you know
Thnx

[saban]

dim strfind1 as string
strfind1 = combobox1

ok I will try it and let you know
Thnx

[saban]

dim strfind1 as string
strfind1 = Combobox1

Tried what you told me but somehow it counts the number of pages corectly which is
sestej = WorksheetFunction.Sum(rCell(1, 3)) + sestej
TextBox1.Text = sestej

But I dont get result from other sheet in listbox

[saban]

Option Explicit

'Module Level Variables
Dim rRange As Range
Dim strFind1 As String
Dim strFind2 As String
Dim strFind3 As String
'Dim strfind4 As String


Private Sub CheckBox1_Click()
ListBox1.MultiSelect = fmMultiSelectMulti
If CheckBox1 = False Then
ListBox1.MultiSelect = fmMultiSelectSingle
End If
End Sub

Private Sub ComboBox1_Change()
'Pass chosen value to String variable strFind1
strFind1 = ComboBox1
'Enable ComboBox2 only if value is chosen
ComboBox2.Enabled = Not strFind1 = vbNullString
End Sub
Private Sub ComboBox2_Change()
'Pass chosen value to String variable strFind1
strFind2 = ComboBox2
'Enable ComboBox3 only if value is chosen
ComboBox3.Enabled = Not strFind2 = vbNullString
End Sub
Private Sub ComboBox3_Change()
'Pass chosen value to String variable strFind1
strFind3 = ComboBox3
End Sub

Private Sub CommandButton1_Click()
'Procedure level variables
Dim ws As Worksheet
Dim lCount As Long
Dim lOccur As Long
Dim rCell As Range
Dim rCell2 As Range
Dim rCell3 As Range
Dim bFound As Boolean
Dim sestej As Long
For Each ws In ActiveWorkbook.Sheets
Set rRange = ws.Range("A1:A100")
'do something

'Dim strfind4 As String
'At least one value, from ComboBox1 must be chosen
If strFind1 & strFind2 & strFind3 = vbNullString Then
MsgBox "Izbran ni bil noben kriterij", vbCritical
Exit Sub 'Go no further
ElseIf strFind1 = vbNullString Then
MsgBox "A value from " & Label1.Caption _
& " must be chosen", vbCritical
Exit Sub 'Go no further
End If

'Clear any old entries
On Error Resume Next
ListBox1.Clear
On Error GoTo 0

'If String variable are empty pass the wildcard character
If strFind2 = vbNullString Then strFind2 = "*"
If strFind3 = vbNullString Then strFind3 = "*"

'Set range variable to first cell in table.
Set rCell = rRange.Cells(1, 1)
'Pass the number of times strFind1 occurs
lOccur = WorksheetFunction.CountIf(rRange.Columns(1), strFind1)

'Loop only as many times as strFind1 occurs
For lCount = 1 To lOccur
'Set the range variable to the found cell. This is then also _
used to start the next Find from (After:=rCell)
Set rCell = rRange.Columns(1).Find(What:=strFind1, After:=rCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Check each find to see if strFind2 and strFind3 occur _
on the same row.
If rCell(1, 2) Like strFind2 And rCell(1, 4) Like strFind3 Then
bFound = True 'Used to not show message box for no value found.
'Add the address of the found cell and the cell on the _
same row but 2 columns to the right.

ListBox1.AddItem rCell.Value
ListBox1.List(ListBox1.ListCount - 1, 1) = rCell.Offset(0, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = rCell.Offset(0, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = rCell.Offset(0, 3).Value
ListBox1.List(ListBox1.ListCount - 1, 4) = rCell.Offset(0, 4).Value
ListBox1.AddItem rCell.Address & ":" & rCell(1, 3).Address

ListBox1.ControlTipText = "Dvoklikni na naslov celice in ne na besedilo (naslov :$A$2:$A$2)"
End If

If rCell(1, 2) Like strFind2 And rCell(1, 4) Like strFind3 Then
sestej = WorksheetFunction.Sum(rCell(1, 3)) + sestej
TextBox1.Text = sestej
End If
Next lCount

If bFound = False Then 'No match
MsgBox "Zapis s tem kriterijem ne obstaja", vbOKOnly
End If
Next ws

End Sub

Private Sub CommandButton2_Click()
'Close UserForm

Unload Me
End Sub


Private Sub CommandButton3_Click()
Dim iListCount As Integer, iColCount As Integer
Dim iRow As Integer
Dim rStartCell As Range

'Dim myrange As Range
'Set myrange = ("A1:B1")
'myRange = OFFSET(Sheet1!$A$2,0,0,COUNTA(Sheet1!$A$2:$A$100),COUNTA(Sheet1!$A$1:$J$1))

'Set a range variable to the first cell to recieve our data
'Using "End(xlUp).Offset(1, 0)" _
will give us the cell below the last entry
Set rStartCell = Sheets("Izpisi").Range("A65536").End(xlUp).Offset(1, 0)

'Loop as many times (less one) as there are entries in our list.
'We must start from zero to use this in the Selected Property.
For iListCount = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(iListCount) = True Then 'User has selected
ListBox1.Selected(iListCount) = False 'Deselect it
iRow = iRow + 1
'Now loop as many times as there are columns in MyRange
For iColCount = 0 To Range("$A$1:$E$1").Columns.Count - 1
'place the selected data into the table, starting from _
range Ax and moving across as many columns as there are _
in the range MyRange.
rStartCell.Cells(iRow, iColCount + 1).Value = _
ListBox1.List(iListCount, iColCount)

Next iColCount
End If
Next iListCount
MsgBox "izbrano besedilo skopirano v Izpisi", vbInformation
Set rStartCell = Nothing

' Call naj
End Sub

Private Sub CommandButton4_Click()
frmTomarDatos.Show
End Sub

Private Sub Label11_Click()

End Sub

Private Sub Label3_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Check for range addresses
If ListBox1.ListCount = 0 Then Exit Sub
'GoTo doubled clicked address
Application.GoTo Range(ListBox1.Text), True
End Sub



Private Sub UserForm_Initialize()
'Procedure level module
Dim lRows As Long

'Set Module level range variable to CurrentRegion _
of the Selection
Set rRange = Selection.CurrentRegion
If rRange.Rows.Count < 2 Then ' Only 1 row
MsgBox "Postavi se na zacetek tabele (v celico A1)", vbCritical
Unload Me 'Close Userform
Exit Sub
Else

With rRange
'Set Label Captions to the Table headings
' Label1.Caption = .Cells(1, 1)
' Label2.Caption = .Cells(1, 2)
' Label3.Caption = .Cells(1, 3)

'Set RowSource of ComboBoxes to the appropriate columns _
inside the table
ComboBox1.RowSource = .Columns(1).Offset(1, 0).Address
ComboBox2.RowSource = .Columns(2).Offset(1, 0).Address
ComboBox3.RowSource = .Columns(4).Offset(1, 0).Address
End With
End If
End Sub

Private Sub UserForm_Terminate()
'Destroy Module level variables
Set rRange = Nothing
strFind1 = vbNullString
strFind2 = vbNullString
strFind3 = vbNullString
End Sub

here is the whole code of search form