Protection nightmare

  • Thread starter Thread starter Joe Bannister
  • Start date Start date
J

Joe Bannister

Can anyone help me please?

The following is my code which compares cell data and
does various operations, it is quite complicated.

My problem is basically that when someone enters
deliveries in the relevant cells and the macro is run,
those cells become protected but were not before.

Can anyone see in the code anything that causes this to
happen?

Cheers

Joe

'First job is to carry forward bookstocks
Sheets("BOOKSTOCK").Select
'Top section left to right
For z = 4 To 24 Step 2

'Dim first As String
'Chooses stock b/f serial code
For a = 7 To 17 Step 2
Cells(a, z).Select
'first = ActiveCell

'Chooses stock used serial code and compares to stock
b/f
'If same then takes closing no up to stock b/f
For b = 25 To 27 Step 2
Cells(b, z).Select
'If ActiveCell = first Then
If Cells(b, z) = Cells(a, z) Then
Cells(b, z + 1).Select: Selection.Copy: Cells(a +
1, z + 1).Select: Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
End If
Next b

Next a

'Dim second As String
'Chooses deliveries stock serial code
For c = 19 To 23 Step 2
Cells(c, z).Select
'second = ActiveCell

'Chooses stock used serial code and compares to stock
deliveries
'If same then takes closing no to deliveries
For d = 25 To 27 Step 2
Cells(d, z).Select
'If ActiveCell = second Then
If Cells(d, z) = Cells(c, z) Then
Cells(d, z + 1).Select: Selection.Copy: Cells(c +
1, z + 1).Select: Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
End If
Next d

Next c

'Compares stock b/f code no's and if same deletes
'For f = 5 To 10 Step 2
For e = 34 To 44 Step 2
Cells(e, z + 1).Select
If ActiveCell = 0 Then
Cells(e - 27, z).Select: Selection.ClearContents
Cells(e - 27, z + 1).Select:
Selection.ClearContents
Cells(e - 26, z + 1).Select:
Selection.ClearContents
End If
Next e
'Next f

'Compares deliveries code no's and if same deletes
'For g = 5 To 10 Step 2
For h = 46 To 50 Step 2
Cells(h, z + 1).Select
If ActiveCell = 0 Then
Cells(h - 27, z).Select: Selection.ClearContents
Cells(h - 27, z + 1).Select:
Selection.ClearContents
Cells(h - 26, z + 1).Select:
Selection.ClearContents
End If
Next h
'Next g

'Copies serial code into second line
For i = 7 To 23 Step 2
Cells(i, z).Select
Selection.Copy
Cells(i + 1, z).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i

'Sorts stock
Range(Cells(7, z), Cells(24, z + 1)).Select
Selection.sort Key1:=Cells(7, z),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'Clears second line of serial code
For j = 7 To 17 Step 2
Cells(j + 1, z).Select
Selection.ClearContents
Next j

'Range("D8").Select
'Selection.ClearContents

'Makes stock b/f section white
Range(Cells(7, z), Cells(18, z + 1)).Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With

'Makes deliveries section yelow
Range(Cells(19, z), Cells(24, z + 1)).Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

'Clears serial codes in used section
Range(Cells(25, z), Cells(28, z)).Select
Selection.ClearContents

'Clears unwanted stray figures
For k = 7 To 17 Step 2
Cells(k, z + 1).Select
If ActiveCell = "" Then
'Cells(k + 1, z + 1).Select:
Selection.ClearContents
Range(Cells(k, z + 1), Cells(k + 1, z + 1)).Select
Selection.ClearContents
End If
Next k


Next z
 
try this
Sub ddd()
ActiveSheet.Unprotect
For Each c In [a2:a22]
If Len(c) > 0 Then c.Locked = True
Next
ActiveSheet.Protect
End Sub

BTW You really should remove all of those selections
For b = 25 To 27 Step 2
If Cells(b, z) = Cells(a, z) Then Cells(b, z + 1).Copy Cells(a + 1,
z + 1)
Next b
 
Back
Top