As Excel tends to get corrupted with simultaneous data entry on a particular time from various sources ... so it is better not to use Excel Shared!
Private Sub cmdOpen_Click()
'On Error Resume Next
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled
If cboSelect.Value = "" Then
MsgBox "Please choose User", , "Nordic TE SLA Warning :: Choose User"
ElseIf ThisWorkbook.Sheets("Control Panel").Range("N20").Value <> ThisWorkbook.Sheets("Control Panel").Range("J15").Value Then
MsgBox "Please choose Your Name!", , "Nordic TE SLA Warning :: Choose User"
Cancel = True
Else
frmDataInput.Show
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableCancelKey = xlInterrupt
End Sub
Creating a form for data entry is best to perform all the validations you want to perform in user level as well as ensuring right data entry.
Private Sub cboSelect_Click()
Worksheets("Control Panel").Range("J15") = Me.cboSelect.Value
End Sub
Private Sub cmdUp_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled
Dim wb2 As Workbook, ws As Worksheet, str6 As String, str7 As String, str4 As String, Report_SLA As String, strName As String, str5 As String, strFile As String
strName = "SLA_" & ThisWorkbook.Sheets("Control Panel").Range("N20").Value
ThisWorkbook.Sheets("Control Panel").Range("N27") = strName
str6 = ThisWorkbook.Sheets("Control Panel").Range("N26").Value
str7 = ThisWorkbook.Sheets("Control Panel").Range("N27").Value
str4 = ".xls"
str5 = ".xlsx"
Dim strMsg As String
strMsg = "Do You want to update the Data file? Proceed only if you have the back up file."
strMsg = strMsg & "Click Yes to Continue or No to Discard."
If MsgBox(strMsg, vbQuestion + vbYesNo, "Update Data? :: OS TE SLA Information!") = vbYes Then
ThisWorkbook.Sheets("Data").Visible = True
ThisWorkbook.Sheets("Data").Select
ActiveSheet.Range("A2:AZ65536").Delete Shift:=xlUp
Report_SLA = (str6 & "\" & str7 & str4)
'Set wb2 = Workbooks.Open(Report_SLA)
'wb2.Activate
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = strName
.Filters.Add "*.xls files", "*.xls", 1
.Filters.Add "*.xlsx files", "*.xlsx", 2
If .Show = -1 Then
strFile = .SelectedItems(1)
Set wb2 = Workbooks.Open(strFile)
Set ws = ActiveWorkbook.Sheets("Data")
ActiveSheet.Range("A2:AZ65536").Copy
ThisWorkbook.Activate
frmDataInput.Hide
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Data").Visible = True
ThisWorkbook.Sheets("Data").Select
ThisWorkbook.Sheets("Data").Activate
ThisWorkbook.Sheets("Data").Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ThisWorkbook.Sheets("Data").Range("A1:AZ1").Interior.ColorIndex = 10
End If
End With
Else
Exit Sub
End If
wb2.Activate
wb2.Close (False)
ThisWorkbook.Activate
ThisWorkbook.Sheets("Control Panel").Select
frmDataInput.Hide
Range("N26").Select
ThisWorkbook.Sheets("Data").Visible = xlVeryHidden
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableCancelKey = xlInterrupt
End Sub
Private Sub cmdClear_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled
Dim strMsg As String
strMsg = "Clear all the Data you have?"
strMsg = strMsg & " Click Yes to Continue or No to Discard."
If MsgBox(strMsg, vbQuestion + vbYesNo, "Clear Report? :: Nordic TE SLA Warning!") = vbYes Then
Call Delete_Data
ThisWorkbook.Sheets("Control Panel").Select
Range("N20").Select
ThisWorkbook.Sheets("Data").Visible = xlVeryHidden
Else
Exit Sub
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableCancelKey = xlInterrupt
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled
If ThisWorkbook.Sheets("Control Panel").Range("J15").Value = "" Then
MsgBox "Please choose User", , "TE SLA Warning :: Choose User"
Cancel = True
ElseIf ThisWorkbook.Sheets("Control Panel").Range("N20").Value <> ThisWorkbook.Sheets("Control Panel").Range("J15").Value Then
MsgBox "Please choose Your Name!", , "TE SLA Warning :: Choose User"
Cancel = True
Else
Dim NM As String
NM = Worksheets("Control Panel").Range("J15")
Dim objFSO As Object
Dim strPath As String
Dim strName As String
strName = "SLA" & "_" & NM
ThisWorkbook.Sheets("Control Panel").Range("N27") = strName
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPath = Worksheets("Control Panel").Range("N29")
If Not objFSO.FolderExists(strPath) Then objFSO.CreateFolder (strPath)
ThisWorkbook.Sheets("Data").Visible = True
Sheets(Array("Data")).Copy
With ActiveWorkbook
.SaveAs strPath & "\" & strName
.Close False
End With
Set objFSO = Nothing
Dim NM2 As String
NM2 = Worksheets("Control Panel").Range("J15")
Dim objFSO2 As Object
Dim strPath2 As String
Dim strName2 As String
strName2 = "SLA" & "_" & NM2 & "_" & Format((Date), "dd-mmm-yy")
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
strPath2 = Worksheets("Control Panel").Range("N31")
If Not objFSO2.FolderExists(strPath2) Then objFSO2.CreateFolder (strPath2)
ThisWorkbook.Sheets("Data").Visible = True
Sheets(Array("Data")).Copy
With ActiveWorkbook
.SaveAs strPath2 & "\" & strName2
.Close False
End With
Set objFSO2 = Nothing
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableCancelKey = xlInterrupt
End Sub
Private Sub Workbook_Open()
On Error Resume Next
ThisWorkbook.Sheets("Control Panel").Select
Worksheets("Control Panel").OLEObjects("cmdOpen").Enabled = True
Worksheets("Control Panel").Range("N17").Value = Format((Date), "dd-mmm-yyyy")
Worksheets("Control Panel").Range("O17").Value = Format((Now), "hh:mm:ss AM/PM")
Worksheets("Control Panel").Range("N20").Select
Worksheets("Control Panel").OLEObjects("cboSelect").Object.Value = ""
Worksheets("Control Panel").Range("J15") = ""
ThisWorkbook.Sheets("Control Panel").Range("isFormActive").Value = ""
ThisWorkbook.Sheets("Data").Visible = xlVeryHidden
End Sub
Private Sub Workbook_Activate()
On Error Resume Next
If ThisWorkbook.Sheets("Control Panel").Range("isFormActive").Value = True Then
frmDataInput.Show
End If
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
If frmDataInput.Visible Then
ThisWorkbook.Sheets("Control Panel").Range("isFormActive").Value = True
frmDataInput.Hide
Else
ThisWorkbook.Sheets("Control Panel").Range("isFormActive").Value = False
End If
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (3)
Author
Commented:Author
Commented:Commented:
Congratulations! Your article has been published.
ericpete
Page Editor