On error resume next? question - problem

A

Andrzej

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\BAZA\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\NARZEDZIA\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\BAZA\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
 
T

Tom Ogilvy

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\BAZA\katalog.xls")
End if
 
A

Andrzej

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
 
T

Tom Ogilvy

If by

If cell = "" Then cell.Locked = False

you want to unlock empty cells then


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i as long, j as Long, max as Long
Dim LiczCols As Long

Dim bk As Workbook
Dim sh As Worksheet
Dim sh1 As Integer
Dim rng as Range

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
cells.Locked = True
set rng = nothing
On error resume Next
set rng = cells.SpecialCells(xlBlanks)
On Error goto 0
if not rng is nothing then
rng.Locked = False
end if
Sheets(j).Protect

Next j

Application.ScreenUpdating = True
End Sub
 
A

Andrzej

Work ok...,but is it different problem.

I have 3 catalogues:
NARZEDZIA,
PRZYRZADY,
SPRAWDZIANY,

and in every of them is two files about the same names, Exactly:
katalog.xls and baza_cech.xls

What happend if some person opened katalog.xls from NARZEDZIA and at the
same time other person opened katalog.xls from ..for example SPRAWDZIANY...

mistake step out??? and if not... of which file will be search??

Will the change of name of files be only solution?

for example:

katalog_s.xls in SPRAWDZIANY

katalog_p.xls in PRZYRZADY

katalog_n.xls in NARZEDZIA

What do you think?

Pozdrowienia,

Andrzej
 
T

Tom Ogilvy

ActiveWorkbook.FullName

will tell you the fully qualified path of the workbook. Perhaps that will
help you decide

sFullName = Bk.FullName
sLtr = ""
if inStr(1,sFullName,"Narzedzia",vbTextCompare) then
sLtr = "N"
else if instr(1,sFullName,"Sprawdziany",vbTextCompare) then
sLtr = "S"
else if instr(1,sFullName,"PRZYRZADY",vbTextCompare) then
sLtr = "P"
End if

obviously using sLtr is just to illustrate doing something in the If
statement.
 
A

Andrzej

your code didn' t work corectly..

I need:

If cells are empty then is unlock
and if cells.value <>"" then i wont to lock this cells in every sheets..
 
T

Tom Ogilvy

That is what the code does (based on the assumptions I stated). Sorry if
you can't get it to work for you.
 
A

Andrzej

Hi, Tom

I do not know why... but cells be blocked variously ( I would say that
accidentally). Sometimes every sheet, sometimes only one column...
Surely will you give this strange ? but it yes.

maybe therefore, that in my project are more options... and something
"bites" maybe? For example: the adding for administrator of file the new
menu (and his removal after close)

I think that only solution to this work correctly (because it can we do not
understand each other) it is.. if you saw this project on live.

I do not know I should ask about this? but I will ask..

Could I send my project on your priv??

Pozdrawiam,

Andrzej
 
T

Tom Ogilvy

I can look at the protect unprotect if you want to send it to

(e-mail address removed)
 
A

Andrzej

Hi Tom,
I know probably?? why we don't understand each other.
Your code selected some range (similarly how this was in my code) for
example A1:D20 it agrees?
and in this range it work correctly. If cells empty - unlock it,
if cell is full lock it.. OK, but all cells below this range are LOCK,
and I would like to they were UNLOCK., because users will be write new data
(records),, but how will they write if cells be blocked?

in this example I would like to:

1) column Tand every follows will be lock (U,V,W etc)

2) in range A1:D20 (if cell full - lock, if cell empty - unlock)

3) every cells belows row 20 (but only to column number 20) will be unlock
(A21:T65535)

I hope so you understand me.



Pozdrawiam Andrzej
 
T

Tom Ogilvy

Just make unlock the default

Dim rng1 as Range
Dim rng2 as Range
Cells.Locked = False
on Error Resume Next
set rng1 = cells.SpecialCells(xlconstants)
set rng2 = cells.specialCells(xlformulas)
On Error goto 0
if not rng1 is nothing then rng1.Locked = True
if not rng2 is nothing then rng2.Locked = True
 
A

Andrzej

OK
this code work for every cells for sheets.. but I would like to every cells
(colums) on the right of last this cells
Cecha RSAb Sekcja/Osoba/Data

will be lock.

If you open my project.. so probably you will be know what I want.

Pozdrowienia
Andrzej
 
T

Tom Ogilvy

Dim rng1 as Range
Dim rng2 as Range
Cells.Locked = False
on Error Resume Next
set rng1 = cells.SpecialCells(xlconstants)
set rng2 = cells.specialCells(xlformulas)
On Error goto 0
if not rng1 is nothing then rng1.Locked = True
if not rng2 is nothing then rng2.Locked = True
Range("A:IV").Locked = True


Adjust to suit.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Cells.Find , why it DOESN'T search ? help 7
I have question.. I have problem with Cells.find 7
How to open file in the background. It is possible? 1
I have question.. I have problem with Cells.find 0
Word macro that can call cells out of Excel for a find and replace 0
Making a macro only work on certain files 2
Remove Identical words 0
Vaiable Help in VBA 5

Top