ok, but something is wrong.. because when find "cecha" displays
error: Aplication defined or object defined error.. (1004)

Mayby I made any mistakein filekatalog.xls?

Can you look at this code? (in file katalog)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i, j, max, LiczCols As Integer

Dim bk As Workbook
Dim sh As Worksheet
Dim sh1 As Integer


If Not Me.Saved Then
Msg = "Czy zapisac zmiany w (save the change in)"
Msg = Msg & Me.Name & "?"
ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
Select Case ans
Case vbYes
Me.Save
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
Call DeleteMenu

' blokada komorek wpisanych t(he blockade of full cells )

sh1 = ActiveWorkbook.Worksheets.Count

Application.ScreenUpdating = False

For j = 1 To sh1

Sheets(j).Activate
Sheets(j).Unprotect
'max = Range(Cells(1, 1), Selection.End _
(xlToRight)).Count
max = 1
'liczba kolumn wype³nionych
Cells(1, 1).Select
' okreslenie zakresu
LiczCols = Range(Selection, Selection.End _
(xlToRight)).Count
For i = 1 To LiczCols
If Range(Selection, Selection.End _
(xlDown)).Count max _
Then max = Range _
(Selection, Selection.End(xlDown)).Count
Cells(1, i).Select ' -in this line is ERROR
Next i
' Cells(10, 1) = "A1:A" & max
' zaznacz zakres i zablokuj niepuste komorki
Range("A1:A" & max).Select
Range(Selection, Selection.End _
(xlToRight)).Select
'Selection.Locked = True
For Each cell In Selection
If cell < "" Then cell.Locked = True
If cell = "" Then cell.Locked = False

Next cell

Sheets(j).Protect

Next j

Application.ScreenUpdating = True
End Sub





U¿ytkownik "Tom Ogilvy" napisa³ w wiadomo¶ci
...
On Error Resume Next
set bk = Workbooks("katalog.xls")
On Error goto 0
if bk is nothing then
Set bk = Workbooks.Open _
("D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\NARZEDZIA\B AZA\katalog.xls")
End if

--
Regards,
Tom Ogilvy




"Andrzej" wrote in message
...
I have a code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim szukana As Range
Dim Cecha As String
Dim bk As Workbook
Dim sh As Worksheet
Dim sh1 As Worksheet

Application.ScreenUpdating = False

If Not Application.Intersect(Columns("A:A"), Target) _
Is Nothing Then

Cecha = Target.Value
If Cecha = "" Then Exit Sub

On Error Resume Next
Set bk = Workbooks _
("D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\NARZEDZIA\B AZA\katalog.xls")
On Error GoTo 0
If bk Is Nothing Then
If Err < 0 Then
Set bk = Workbooks.Open _


(Filename:="D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\N ARZEDZIA\BAZA\katalog.xls"
)

End If

Set sh1 = bk.Worksheets(bk.Worksheets.Count)
For Each sh In bk.Worksheets
Set szukana = sh.Cells.Find(What:=Cecha, _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
', _
' SearchFormat:=False)

If szukana Is Nothing Then
If sh.Name = sh1.Name Then
MsgBox "Szukana cecha """ & Cecha & """ nie zosta³a odnaleziona"
ActiveWorkbook.Close
Target.Value = ""
End If
Else

bk.Activate
sh.Activate
szukana.Activate
MsgBox "Szukana cecha """ & Cecha & """ zosta³a odnaleziona"
'ActiveWorkbook.Close
'ActiveCell.Value = Cecha
End If
Next sh

End If

Application.ScreenUpdating = True

end sub

I try to ptecect my code before situation that file:
("D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\NARZEDZIA\B AZA\katalog.xls")
was earlier opened by differend user.
If this file was earlier opened, then I would like to my code don't
open
again this file, just only search for "cecha"
else
i would like to my code open the file and search for "cecha"

Someone knows more practical solution ?
this my does not work

Andrzej