N
NJP
I have a protected manually calculated sheet that gets data from a sql
query. The code unprotects the sheet, updates the query, calculates the
sheet, and then reproctecs the sheet.
I get an error message concerning updating protected ranges when executing
the marco. If I remark the reprotection step, every thing updates porperly.
I tried playing around with wating for the calculations to finish before
reportecting the sheet, but this amatuer is having issues.
Any suggestions?
Private Sub ImportMTL_Click()
Worksheets("Import MTL Data - Perform Calcs").Unprotect Password:="mpsme"
response = MsgBox("Are your constants filled in properly? Have you selected
your plant? Have your update the date range? If so, then click OK to
continue.", vbOK, "Importing MTL Data")
If response = 1 Then
Worksheets("Define Constants").Calculate
Worksheets("Import MTL Data - Perform Calcs").Select
Range("B3").FormulaR1C1 = Worksheets("Define COnstants").Range("DBName")
Range("Q4").FormulaR1C1 = Worksheets("Define COnstants").Range("NOTE_LN")
Range("T4").FormulaR1C1 = Worksheets("Define COnstants").Range("DR_TXT")
Worksheets("Import MTL Data - Perform Calcs").Calculate
updatedata
End If
Application.Calculation = xlCalculationManual
Dim check, counter
check = True: counter = 0
Do
Do While counter < 20
counter = counter + 1
If Application.CalculationState = xlDone Or counter = 19 Then
check = False
Exit Do
End If
Loop
Loop Until check = False
Worksheets("Import MTL Data - Perform Calcs").Protect Password:="mpsme", _
Contents:=True, Scenarios:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True, _
AllowFiltering:=True, DrawingObjects:=True, AllowDeletingRows:=True
End Sub
Sub updatedata()
'import data from a selected MTL
Dim strConn As String, strMdw As String
dtStart = Range("StartDate")
dtEnd = Range("EndDate")
strDBLocation = Range("Path")
strMdw = Left(strDBLocation, Len(strDBLocation) - 1) & "w"
myRow = Range("C1").Value + 4
dtRange = Range("DateRange")
plant = Range("PlantFunction")
Application.ScreenUpdating = False
Select Case Range("SHIFTS").Value
Case 2
Range("TWO_SHIFT").Copy Range("F5:F" & myRow)
Case 3
Range("THREE_SHIFT").Copy Range("F5:F" & myRow)
Case OTHER
End Select
strConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password='';" & _
"User ID=MTL_User;Data Source='" & strDBLocation & "';Mode=Share Deny None;"
& _
"Extended Properties='';Jet OLEDB:System database='" & strMdw & "';" & _
"Jet OLEDB:Registry Path='';Jet OLEDBatabase Password='';" & _
"Jet OLEDB:Engine Type=5;Jet OLEDBatabase Locking Mode=0;" & _
"Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;"
& _
"Jet OLEDB:New Database Password='';Jet OLEDB:Create System Database=False;"
& _
"Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on
Compact=False;" & _
"Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"
Worksheets("Import MTL Data - Perform Calcs").QueryTables(1).Connection =
strConn
Sql = "SELECT DISTINCT tblCompletedTasks.Activity_Desc, tblAreas.AreaDesc, "
& _
"tblCompletedTasks.ComplianceTask, tblCompletedTasks.EnteredBy, " & _
"Format([tblCompletedTasks]![StartDate],'Short Date') AS StartDate,
tblCompletedTasks.StartTime, tblCompletedTasks.DueDate, " & _
"tblCompletedTasks.DueTime, tblWorkgroups.WorkgroupDesc, " & _
"tblCompletedTasks.Est_Duration, tblCompletedTasks.Status,
tblCompletedTasks.Notes, " & _
"(tblCompletedTasks.strResourceID <> '') AS OPP,
tblCompletedTasks.OverdueFlag, " & _
"IIf(Not IsNull([lngDocumentID]),True,False) AS HasLinks " & _
"FROM ((tblCompletedTasks LEFT JOIN tblAreas ON tblCompletedTasks.Area = " & _
"tblAreas.AreaID) LEFT JOIN tblWorkgroups ON
tblCompletedTasks.AssignedWorkgroup = " & _
"tblWorkgroups.WorkgroupID) LEFT JOIN tblLinkedDocument ON " & _
"tblCompletedTasks.Task_ID = tblLinkedDocument.Task_ID " & _
"WHERE (((tblCompletedTasks.StartDate)>=#" & dtStart & "# And " & _
"(tblCompletedTasks.StartDate)<=#" & dtEnd & "#) AND
((tblCompletedTasks.Status)<>'O')) " & _
"ORDER BY Format([tblCompletedTasks]![StartDate],'Short Date');"
Worksheets("Import MTL Data - Perform
Calcs").QueryTables(1).AdjustColumnWidth = False
Worksheets("Import MTL Data - Perform
Calcs").QueryTables(1).FillAdjacentFormulas = True
Worksheets("Import MTL Data - Perform Calcs").QueryTables(1).CommandText = Sql
Worksheets("Import MTL Data - Perform Calcs").QueryTables(1).Refresh
Worksheets("Import MTL Data - Perform Calcs").Calculate
'update task distribution
Range("v3:x3").Select
Selection.Copy
Sheets("MTL Tracking Data").Select
If IsEmpty(Range("v2")) Then
Range("x2").Select
Else
Range("v1").End(xlDown).Offset(1, 2).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -2).Formula = plant
ActiveCell.Offset(0, -1).Formula = dtRange
UpdateTimeDistPivot
Sheets("Import MTL Data - Perform Calcs").Select
Application.ScreenUpdating = True
End Sub
query. The code unprotects the sheet, updates the query, calculates the
sheet, and then reproctecs the sheet.
I get an error message concerning updating protected ranges when executing
the marco. If I remark the reprotection step, every thing updates porperly.
I tried playing around with wating for the calculations to finish before
reportecting the sheet, but this amatuer is having issues.
Any suggestions?
Private Sub ImportMTL_Click()
Worksheets("Import MTL Data - Perform Calcs").Unprotect Password:="mpsme"
response = MsgBox("Are your constants filled in properly? Have you selected
your plant? Have your update the date range? If so, then click OK to
continue.", vbOK, "Importing MTL Data")
If response = 1 Then
Worksheets("Define Constants").Calculate
Worksheets("Import MTL Data - Perform Calcs").Select
Range("B3").FormulaR1C1 = Worksheets("Define COnstants").Range("DBName")
Range("Q4").FormulaR1C1 = Worksheets("Define COnstants").Range("NOTE_LN")
Range("T4").FormulaR1C1 = Worksheets("Define COnstants").Range("DR_TXT")
Worksheets("Import MTL Data - Perform Calcs").Calculate
updatedata
End If
Application.Calculation = xlCalculationManual
Dim check, counter
check = True: counter = 0
Do
Do While counter < 20
counter = counter + 1
If Application.CalculationState = xlDone Or counter = 19 Then
check = False
Exit Do
End If
Loop
Loop Until check = False
Worksheets("Import MTL Data - Perform Calcs").Protect Password:="mpsme", _
Contents:=True, Scenarios:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True, _
AllowFiltering:=True, DrawingObjects:=True, AllowDeletingRows:=True
End Sub
Sub updatedata()
'import data from a selected MTL
Dim strConn As String, strMdw As String
dtStart = Range("StartDate")
dtEnd = Range("EndDate")
strDBLocation = Range("Path")
strMdw = Left(strDBLocation, Len(strDBLocation) - 1) & "w"
myRow = Range("C1").Value + 4
dtRange = Range("DateRange")
plant = Range("PlantFunction")
Application.ScreenUpdating = False
Select Case Range("SHIFTS").Value
Case 2
Range("TWO_SHIFT").Copy Range("F5:F" & myRow)
Case 3
Range("THREE_SHIFT").Copy Range("F5:F" & myRow)
Case OTHER
End Select
strConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password='';" & _
"User ID=MTL_User;Data Source='" & strDBLocation & "';Mode=Share Deny None;"
& _
"Extended Properties='';Jet OLEDB:System database='" & strMdw & "';" & _
"Jet OLEDB:Registry Path='';Jet OLEDBatabase Password='';" & _
"Jet OLEDB:Engine Type=5;Jet OLEDBatabase Locking Mode=0;" & _
"Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;"
& _
"Jet OLEDB:New Database Password='';Jet OLEDB:Create System Database=False;"
& _
"Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on
Compact=False;" & _
"Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"
Worksheets("Import MTL Data - Perform Calcs").QueryTables(1).Connection =
strConn
Sql = "SELECT DISTINCT tblCompletedTasks.Activity_Desc, tblAreas.AreaDesc, "
& _
"tblCompletedTasks.ComplianceTask, tblCompletedTasks.EnteredBy, " & _
"Format([tblCompletedTasks]![StartDate],'Short Date') AS StartDate,
tblCompletedTasks.StartTime, tblCompletedTasks.DueDate, " & _
"tblCompletedTasks.DueTime, tblWorkgroups.WorkgroupDesc, " & _
"tblCompletedTasks.Est_Duration, tblCompletedTasks.Status,
tblCompletedTasks.Notes, " & _
"(tblCompletedTasks.strResourceID <> '') AS OPP,
tblCompletedTasks.OverdueFlag, " & _
"IIf(Not IsNull([lngDocumentID]),True,False) AS HasLinks " & _
"FROM ((tblCompletedTasks LEFT JOIN tblAreas ON tblCompletedTasks.Area = " & _
"tblAreas.AreaID) LEFT JOIN tblWorkgroups ON
tblCompletedTasks.AssignedWorkgroup = " & _
"tblWorkgroups.WorkgroupID) LEFT JOIN tblLinkedDocument ON " & _
"tblCompletedTasks.Task_ID = tblLinkedDocument.Task_ID " & _
"WHERE (((tblCompletedTasks.StartDate)>=#" & dtStart & "# And " & _
"(tblCompletedTasks.StartDate)<=#" & dtEnd & "#) AND
((tblCompletedTasks.Status)<>'O')) " & _
"ORDER BY Format([tblCompletedTasks]![StartDate],'Short Date');"
Worksheets("Import MTL Data - Perform
Calcs").QueryTables(1).AdjustColumnWidth = False
Worksheets("Import MTL Data - Perform
Calcs").QueryTables(1).FillAdjacentFormulas = True
Worksheets("Import MTL Data - Perform Calcs").QueryTables(1).CommandText = Sql
Worksheets("Import MTL Data - Perform Calcs").QueryTables(1).Refresh
Worksheets("Import MTL Data - Perform Calcs").Calculate
'update task distribution
Range("v3:x3").Select
Selection.Copy
Sheets("MTL Tracking Data").Select
If IsEmpty(Range("v2")) Then
Range("x2").Select
Else
Range("v1").End(xlDown).Offset(1, 2).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -2).Formula = plant
ActiveCell.Offset(0, -1).Formula = dtRange
UpdateTimeDistPivot
Sheets("Import MTL Data - Perform Calcs").Select
Application.ScreenUpdating = True
End Sub