Help! Loss of Tab control/cell selection problem

J

jkitzy

Okay, you guys have been especially helpful on this project, but I need yet
more advice. Here's the problem. Well, first, I'm not really a programmer,
just one of those power users smart enough to screw things up.

My workbook has several worksheets that require manipulation after data is
input on a central Information page. So, when they select any worksheet other
than the information page, it performs a series of updates and then goes to
the selected worksheet.

Fair enough. BUT, when the users who have xl2000 do this, they lose the
ability to see the current cell selection and tab or arrow between cells.
Almost like Application.ScreenUpdating never became true. Here's the code of
the various macros called during this process. Any help would be greatly
appreciated. This is driving me crazy because it works fine on my xl2003.

I realized this is a lot of code, but I'm at my wit's end. Or rather, my wit
has left the building. Here are three macros I think may be related to the
problem.

-------------------------
CODE FOLLOWS: line numbers for reference purposes only. They don't appear in
code.
Specific Worksheet_Deactivate()
-------------------------
100 Private Sub Workbook_Open()
110 Dim sh As Worksheet
120 Application.ScreenUpdating = False
130 For Each sh In ThisWorkbook.Worksheets
140 sh.EnableSelection = xlUnlockedCells
150 sh.Protect "unlock", , , userinterfaceonly:=True
160 Next sh
170 Worksheets("HOLIDAYS").Visible = False
180 Worksheets("Information").Activate
200 Application.ScreenUpdating = True
210 End Sub
-------------------------
Line numbers for reference purposes only. They don't appear in code.
Specific Worksheet_Deactivate() for Information (forced to be first sheet by
Workbook_Open
-------------------------
100 Private Sub Worksheet_Deactivate()
110 Application.ScreenUpdating = False

120 Dim RC As Integer
130 Dim WhereAmI As Range
140 Dim T As String
150 Dim H As Worksheet, TA As Worksheet, OO As Worksheet, DS As Worksheet,
TP As Worksheet, SS As Worksheet
160 Dim DI As Sheets

170 T = "Information!"
180 Set H = Worksheets("Holidays")
190 Set TA = Worksheets("TA")
200 Set OO = Worksheets("TOOB")
210 Set TP = Worksheets("Information")
220 Set SS = ActiveSheet

230 If TP.Range("b6") = "" Then
240 TP.Activate
250 mb = MsgBox("Please enter your branch number before working in this
book.", , "TitleBar")
260 GoTo Die
270 End If

280 If TP.Range("j6") = "" Then
290 TP.Activate
300 mb = MsgBox("Please enter the month before working in this book.", ,
"TitleBar")
310 GoTo Die
320 End If

330 H.Activate
340 ActiveSheet.Range("A1").Select
350 ActiveSheet.Cells.Find(What:="STOP", After:=ActiveCell,
LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate
360 ActiveSheet.Range("A2", ActiveCell).Select
370 Selection.EntireRow.Delete
380 ActiveSheet.Range("A2").Select
390 Selection.EntireRow.Insert
400 ActiveSheet.Range("A2").Value = "STOP"
410 Selection.EntireRow.Insert

420 For i = 1 To 20
430 Selection.EntireRow.Insert
440 Next i

450 ActiveSheet.Range("A2").Value = "=Information!B16"
460 ActiveSheet.Range("b2").Value = "=Information!C16"

470 For RC = 3 To 20
480 RP = RC + 14
490 ActiveSheet.Range("A" & RC).Value = "=Information!B" & RP
500 ActiveSheet.Range("B" & RC).Value = "=Information!C" & RP
510 Next RC

520 NR = 0
530 HC = 2
540 PG = 1
550 PA = "B2:N51"

560 For RowCount = 3 To 21
570 AC = RowCount - NR
580 HC = HC + 13
590 If H.Range("A" & AC) = "STOP" Then RowCount = 21
600 If H.Range("B" & AC) = 0 Then
610 H.Range("A" & AC).EntireRow.Delete
620 NR = NR + 1
630 End If
640 Next RowCount

650 H.Cells.Find(What:="STOP", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False).Activate
660 Rcount = ActiveCell.Row
670 H.Cells(1, 5) = 1

680 For i = 1 To 2
690 NR = Rcount - 2
700 HC = 2
710 PG = 1
720 PA = "B2:N51"
730 If i = 1 Then Set DS = TA Else Set DS = OO
740 DS.Select
750 DS.Range("A1", "IV1").Select
760 Selection.EntireColumn.Hidden = False 'Unhide all cells
770 DL = 2
780 For RowCount = 1 To 19
790 TH = DS.Cells(7, HC + 8)
800 CM = H.Cells(DL, 1)
810 If TH = CM Then
820 DS.Cells(1, HC).Value = PG
830 PG = PG + 1
840 DL = DL + 1
850 Else
860 DS.Activate
870 ActiveSheet.Cells(1, HC).Select
880 Selection.EntireColumn.Hidden = True
890 End If
900 HC = HC + 13
910 Next RowCount
920 Next i

930 TA.Activate
940 ActiveSheet.Shapes("Drop Down 11").Select
950 With Selection
960 .ListFillRange = "HOLIDAYS!$A$2:$A" & AC - 1
970 .LinkedCell = "$A$1"
980 .DropDownLines = 21
990 .Display3DShading = True
1000 End With
1010 ActiveSheet.Range("A8").Select

1020 OO.Activate
1030 ActiveSheet.Shapes("Drop Down 3").Select
1040 With Selection
1050 .ListFillRange = "HOLIDAYS!$A$2:$A" & AC - 1
1060 .LinkedCell = "$A$1"
1070 .DropDownLines = 21
1080 .Display3DShading = True
1090 End With
1100 ActiveSheet.Range("A8").Select

1110 SS.Activate
1120 Die:
1130 Application.ScreenUpdating = True
1140 ASU = 0
1150 H.Cells(1, 5) = 0
1160 End Sub

-------------------------
Line numbers for reference purposes only. They don't appear in code.
Global Worksheet_Activate()
-------------------------
100 Private Sub Workbook_SheetActivate(ByVal sh As Object)
110 If Worksheets("HOLIDAYS").Cells(1, 5) = 1 Then GoTo Die
120 If Application.WindowState <> xlMaximized Then Application.WindowState =
xlMaximized
130 Range("A1:N1").Select
140 ActiveWindow.View = xlPageBreakPreview
150 ActiveWindow.Zoom = True

160 For abc = 9 To 1 Step -1
170 ActiveSheet.Range("b" & abc).Activate
180 Next

190 Application.ScreenUpdating = False

200 'selects first unlocked cell on sheet
210 If ActiveSheet.Name = "Cover Sheet" Then GoTo Die
220 emceco = 2
230 For emcero = 1 To 19
240 Cells(emcero, emceco).Activate
250 If ActiveCell.Locked = False Then GoTo Die
260 If emceco < 13 Then
270 emceco = emceco + 1
280 emcero = emcero - 1
290 Else
300 emceco = 1
310 End If
320 If emcero = 19 Then GoTo Die
330 Next

340 Die:
350 Application.ScreenUpdating = True
360 End Sub
 
J

jkitzy

One more thing...

In xl2000, if I manually unprotect an individual sheet, then reprotect it,
the problem goes away. So, something must be wrong in my protect code, but
darned if I know what it is...
 
J

jkitzy

....and through tinkering, I think I solved the problem. Added the following
to the Worksheet_Activate code...
--------------------------------------------------------
snip
--------------------------------------------------------
....
340 Die:
345 ActiveSheet.Unprotect "unlock"
350 Application.ScreenUpdating = True
355 ActiveSheet.Protect "unlock", , , True
360 End Sub
 

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

Top