Hi Guys,
I have had this question on Exel Help Forum for a while now but noone seems to be able to help me. Hoping someone here might.http://www.excelforum.com/showthread.php?t=1140272
I have a lot of code in my workbook all done with help from this forum. I am really not very knowledgeable with it and would love a bit of guidance with the following errors. I am attaching 3 codes. 1. This workbook, 2. Sheet 1 & 3. Sheet 2. Sheet 1 seems to work perfect but with the same code in sheet 3 its not working as well.
Problem 1: I have sheet 1 & 2 set up so that in column E all the text defaults to proper text as in names should start with capitals. This is working fine in sheet 1 but not in sheet 2 for some reason and the code seems to be identical. Also there seems to be a problem selecting cells in sheet 2 but not
sheet 1. I can select a cell and alter it but it is not highlighted on excel and also i cannot tab or scroll through the cells I can just click on them to alter them
Problem 2: I have a code in Sheet 1 & 2 that if there is anything input in Cell D then the date appears in cell 4. This works if I manually type in Cell D but as you can see I also have a code that depending on certain triggers, information auto transfers to sheets 1 & 2 however when this happens the date does not populate in A? Also I was hoping that if the entry in D was then deleted cell A would automatically delete
Would really appreciate your help with this.
This workbook code
I have had this question on Exel Help Forum for a while now but noone seems to be able to help me. Hoping someone here might.http://www.excelforum.com/showthread.php?t=1140272
I have a lot of code in my workbook all done with help from this forum. I am really not very knowledgeable with it and would love a bit of guidance with the following errors. I am attaching 3 codes. 1. This workbook, 2. Sheet 1 & 3. Sheet 2. Sheet 1 seems to work perfect but with the same code in sheet 3 its not working as well.
Problem 1: I have sheet 1 & 2 set up so that in column E all the text defaults to proper text as in names should start with capitals. This is working fine in sheet 1 but not in sheet 2 for some reason and the code seems to be identical. Also there seems to be a problem selecting cells in sheet 2 but not
sheet 1. I can select a cell and alter it but it is not highlighted on excel and also i cannot tab or scroll through the cells I can just click on them to alter them
Problem 2: I have a code in Sheet 1 & 2 that if there is anything input in Cell D then the date appears in cell 4. This works if I manually type in Cell D but as you can see I also have a code that depending on certain triggers, information auto transfers to sheets 1 & 2 however when this happens the date does not populate in A? Also I was hoping that if the entry in D was then deleted cell A would automatically delete
Would really appreciate your help with this.
This workbook code
Code:
Option Explicit
Option Compare Text
Dim ws As Worksheet
Const MaxUses As Long = 5 '<- change uses
Const wsWarningSheet As String = "Splash"
Private Type mySheetVisibilityStructure
sSheetName As String
iVisibility As Long
End Type
Private bGblDoNotCancelIfCalledFromCloseEvent As Boolean
Const sSheetNameThatMUST_REMAIN_VISIBLE = "Splash"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wks As Worksheet
Dim mySheetVisibilityStructureArray() As mySheetVisibilityStructure
Dim i As Long
Dim iVisibility As Long
Dim iVisibilityErrorSheet As Long
Dim sActiveSheetName As String
Dim sErrorSheetName As String
Dim sSheetName As String
'Initialize the 'Sheet Visibiilty Structure Array'
ReDim mySheetVisibilityStructureArray(1 To 1)
'Save the 'Active Sheet' Name
sActiveSheetName = ActiveSheet.Name
'Verify that the 'Master Sheet' exists
On Error Resume Next
iVisibility = Sheets(sSheetNameThatMUST_REMAIN_VISIBLE).Visible
If Err.Number <> 0 Then
Err.Clear
MsgBox "SAVE NOT DONE. Data Integrity Error." & vbCrLf & _
"In order to save this file Sheet '" & sSheetNameThatMUST_REMAIN_VISIBLE & "' MUST EXIST." & vbCrLf & vbCrLf & _
"WARNING. If this condition is NOT CORRECTED, Data may be LOST."
Cancel = True 'Cancel Save
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
'Disable 'Screen Updating' to eliminate Screen Flicker
Application.ScreenUpdating = False
'Save the 'Visibility of Each Sheet'
'Make all Sheets Hidden Except the 'Master Sheet'
For Each wks In ThisWorkbook.Sheets
'Add an element to the 'Sheet Visibiilty Structure Array'
'Put the 'Sheet Name' and the 'Sheet Visibility' in the Array
i = i + 1
ReDim Preserve mySheetVisibilityStructureArray(1 To i)
mySheetVisibilityStructureArray(i).sSheetName = wks.Name
mySheetVisibilityStructureArray(i).iVisibility = wks.Visible
'Make the 'Master Sheet' visible and the Active Sheet
'Hide All other Sheets
If UCase(wks.Name) = UCase(sSheetNameThatMUST_REMAIN_VISIBLE) Then
'Make the 'Master Sheet' visible and make the 'Master Sheet' the 'Active Sheet'
wks.Visible = xlSheetVisible
wks.Activate
Else
'Hide all other Sheets
wks.Visible = xlSheetVeryHidden 'Can be 'xlSheetHidden' or 'xlSheetVeryHidden'
End If
Next wks
'Turn Off Excel Events
Application.EnableEvents = False
'Save this file
ThisWorkbook.Save
'Cancel command removed from here and moved to the bottom of the routine
'Restore Original Sheet Visibility
For i = LBound(mySheetVisibilityStructureArray) To UBound(mySheetVisibilityStructureArray)
sSheetName = mySheetVisibilityStructureArray(i).sSheetName
iVisibility = mySheetVisibilityStructureArray(i).iVisibility
'A runtime error will occur if Excel attempt to hide all Sheets
On Error Resume Next
Sheets(sSheetName).Visible = iVisibility
If Err.Number = 1004 Then
Err.Clear
sErrorSheetName = sSheetName
iVisibilityErrorSheet = iVisibility
End If
On Error GoTo 0
Next i
'If a Sheet had a runtime error - restore it's original visibility
If Len(sErrorSheetName) > 0 Then
Sheets(sErrorSheetName).Visible = iVisibilityErrorSheet
End If
'Resume with the 'Original Active Sheet'
Sheets(sActiveSheetName).Activate
'Turn On Excel Events
'Turn On Screen Updating
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlUnlockedCells
'Cancel Save - to prevent recursion
If bGblDoNotCancelIfCalledFromCloseEvent = True Then
'Do nothing - Prevent Cancel
ElseIf SaveAsUI = True Then
'Do nothing - Prevent Cancel - Allow Save As Dialog Box
Else
Cancel = True
End If
'Reset the Global Called From Save Event Flag
bGblDoNotCancelIfCalledFromCloseEvent = False
End Sub
Public Sub MakeAllSheetsVisible()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Sheets
wks.Visible = xlSheetVisible
Next wks
End Sub
Private Sub Workbook_Open()
For Each ws In ThisWorkbook.Sheets
If ws.Name = wsWarningSheet Then
ws.Visible = True
Else
ws.Visible = xlVeryHidden
End If
Next
'record opening in remote cell
With Sheets(wsWarningSheet).Cells(Rows.Count, Columns.Count)
End With
Const sHide2 As String = "AA:AA, Ak:Ak, Ap:Ap, AQ:AQ, Av:Av, Aw:Aw, Bb:Bb, Bc:Bc, Bh:Bh, Bi:Bi, Bn:Bn, Bo:Bo, Bt:Bt, Bu:Bu, Bz:Bz, ca:ca "
Const sHide4 As String = "I:I, O:O"
Const sHide5 As String = "j:j, o:o"
With Sheet2
Application.EnableEvents = False
.Cells(1, 36).ClearContents
Application.EnableEvents = True
.Unprotect
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
.EnableSelection = xlUnlockedCells
End With
With Sheet4
Application.EnableEvents = False
.Cells(2, 16).ClearContents
Application.EnableEvents = True
.Unprotect
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
.EnableSelection = xlUnlockedCells
End With
With Sheet5
Application.EnableEvents = False
.Cells(1, 17).ClearContents
Application.EnableEvents = True
.Unprotect
.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
.EnableSelection = xlUnlockedCells
End With
UserForm1.Show
'Enable Timers on Workbook Open
bGblInhibitTimers = False
'Stop all timers
On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
On Error GoTo 0
'Arm Timer to save and close workbook
RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
Application.OnTime RunWhen, "SaveAndClose", , True
'Arm Timer to display time remaining
RunStatusBarWhen = Now + TimeSerial(0, 0, STATUS_BAR_REFRESH_TIME_IN_SECONDS)
Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
'Display Time Remaining Only When timers are enabled
If bGblInhibitTimers = False Then
RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
Application.OnTime RunWhen, "SaveAndClose", , True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
'Display Time Remaining Only When timers are enabled
If bGblInhibitTimers = False Then
RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
Application.OnTime RunWhen, "SaveAndClose", , True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Hide all sheets except the splash sheet
SHideAllSheets
'Stop all timers
On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
On Error GoTo 0
'Disable 'Save Cancel' if Called from Here
bGblDoNotCancelIfCalledFromCloseEvent = True
'Clear the Status Bar
Application.StatusBar = ""
End Sub
Sub SHideAllSheets()
Dim ws As Worksheet
' global constant
' Const wsWarningSheet As String = "Splash"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
If ws.Name = wsWarningSheet Then
ws.Visible = True
Else
ws.Visible = xlVeryHidden
End If
Next
ThisWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub