Option Explicit
Const PhraseConstString As String = "Password"
Dim strFile As String, SATfile As Workbook, SATsht As Worksheet
Dim SATRows As Long, SATCols As Long
Dim MARoldRows As Long
Dim MARnewRows As Long, MARCols As Long
Dim X As Long, Y As Long, Z As Long
Dim SATheader As Byte, MARheader As Byte
Dim SATheaderRng As Range, MARheaderRng As Range
Dim MARfile As Workbook
Dim DuplicateStr As String, DuplicateStrList As String
Dim EachActivity As Range, TotalRng As Range, MARrange As Range, SATrange As Range
Dim MARFilters(0 To 2) As String
Dim AdditionsCount As Long, DeletionsCount As Long, ModificationsCount As Long
Dim MDsht As Worksheet
Dim MDrows As Long, MDcols As Long
Sub Add_New_Transitioned_Activities()
Application.ScreenUpdating = False
If MsgBox("Would you like to add the Newly Transitioned Activities?", vbYesNo, "New Transitioned Activities") = vbNo Then
MsgBox "Execution Cancelled"
Exit Sub
End If
Call Unlock_UnhideAllSheets
strFile = Application.GetOpenFilename(Title:="Select the appropriate Standard Activities Template")
Application.DisplayAlerts = False
Workbooks.Open (strFile)
Application.DisplayAlerts = True
strFile = ActiveWorkbook.Name
Set SATfile = Workbooks(strFile)
Set SATsht = SATfile.Sheets("Activity")
SATsht.AutoFilterMode = False
SATRows = SATsht.Range("B" & Rows.Count).End(xlUp).Row
SATCols = SATsht.Cells(2, Columns.Count).End(xlToLeft).Column
Set SATheaderRng = SATsht.Range(Cells(2, 2), Cells(2, SATCols))
Set SATrange = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
With SATrange
.Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
End With
Set SATrange = SATsht.Range(Cells(3, 13), Cells(SATRows, 13))
With SATrange
.Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
End With
MARFilters(0) = "Addition of New Activity"
MARFilters(1) = "Deactivate Activity in the Master List"
MARFilters(2) = "Modify exisiting activity level details"
Set MARfile = ThisWorkbook
MARfile.Activate
MARfile.Sheets(1).AutoFilterMode = False
MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
MARCols = MARfile.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
For Z = 0 To 2
If Z = 0 Then
On Error Resume Next
With SATsht
.Activate
.AutoFilterMode = False
.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=2, Criteria1:="Addition of New Activity"
End With
If SATsht.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
MsgBox "There are no New Addions request, please cross-check"
GoTo NextMARFilter
End If
On Error GoTo 0
Set MARfile = ThisWorkbook
MARfile.Activate
On Error Resume Next
MARfile.Sheets(1).ShowAllData
On Error GoTo 0
MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
MARCols = MARfile.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
Set MARheaderRng = MARfile.Sheets(1).Range(Cells(1, 1), Cells(1, MARCols))
MARheader = Application.WorksheetFunction.Match("Activity / Business Process Name", MARheaderRng, 0)
Set MARrange = MARfile.Sheets(1).Range(Cells(2, MARheader), Cells(MARoldRows, MARheader))
SATfile.Activate
Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
DuplicateStr = ""
DuplicateStrList = ""
For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
If Application.WorksheetFunction.CountIf(MARrange, EachActivity) > 0 Then
EachActivity.Font.Color = vbRed
If DuplicateStr = "" Then
DuplicateStr = EachActivity
DuplicateStrList = "<>" & EachActivity
Else
DuplicateStr = DuplicateStr & vbNewLine & EachActivity
DuplicateStrList = DuplicateStrList & "," & "<>" & EachActivity
End If
End If
Next
With SATsht
.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=12, Operator:=xlFilterAutomaticFontColor
End With
If SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
AdditionsCount = SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count
MsgBox "There are no New Additions after filtering out the Duplicate Activities"
GoTo NextMARFilter
End If
AdditionsCount = SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1
For X = 2 To SATCols
On Error Resume Next
Debug.Print SATsht.Cells(2, X)
MARheader = Application.WorksheetFunction.Match(SATsht.Cells(2, X), MARheaderRng, 0)
If Err.Number > 0 Then GoTo NextHeader
On Error GoTo 0
SATfile.Activate
If AdditionsCount = 1 Then
SATsht.Cells(3, X).Select
Else
SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select
End If
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
NextHeader:
Next
MARnewRows = MARfile.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
MARheader = Application.WorksheetFunction.Match("Department", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
For X = MARoldRows + 1 To MARnewRows
MARfile.Sheets(1).Range("D" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 2, 0)
Next X
For X = MARoldRows + 1 To MARnewRows
MARfile.Sheets(1).Range("E" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 3, 0)
Next X
MARheader = Application.WorksheetFunction.Match("SVP", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 9), Cells(SATRows, 9)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
MARheader = Application.WorksheetFunction.Match("Activity / Business Process Name", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 12), Cells(SATRows, 12)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
Set MARrange = MARfile.Sheets(1).Range(Cells(2, MARheader), Cells(MARnewRows, MARheader))
With MARrange
.Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
End With
MARheader = Application.WorksheetFunction.Match("Sub-Process / Function", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 15), Cells(SATRows, 15)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
For X = MARoldRows + 1 To MARnewRows
MARfile.Sheets(1).Range("L" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("K" & X), MARfile.Sheets("Reference").Range("F1:G30"), 2, 0)
Next X
MARheader = Application.WorksheetFunction.Match("Default AHT", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 20), Cells(SATRows, 20)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
MARheader = Application.WorksheetFunction.Match("Functional Playbook", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 21), Cells(SATRows, 21)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
MARheader = Application.WorksheetFunction.Match("Backup Team Member # 1", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 46), Cells(SATRows, 46)).Offset(0, 0).Resize(, 3).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
MARheader = Application.WorksheetFunction.Match("Activity Recording URL", MARheaderRng, 0)
SATfile.Activate
SATsht.Range(Cells(3, 52), Cells(SATRows, 52)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
MARfile.Activate
MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
MARheader = Application.WorksheetFunction.Match("Comments", MARheaderRng, 0)
MARfile.Sheets(1).Range(Cells(MARoldRows + 1, MARheader), Cells(MARnewRows, MARheader)).Value = "" & Format(Date, "mm/dd/yyyy") & ": Added as per the request received"
MARheader = Application.WorksheetFunction.Match("S.No", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARheader = Application.WorksheetFunction.Match("Activity Code", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARheader = Application.WorksheetFunction.Match("Sub-Function Code", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARheader = Application.WorksheetFunction.Match("WBS Charge Code", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARfile.Sheets(1).Range(Cells(1, 1), Cells(MARnewRows, MARCols)).Borders.LineStyle = xlContinuous
On Error Resume Next
MARfile.Sheets(1).ShowAllData
On Error GoTo 0
MARfile.Sheets("Macro").Activate
If DuplicateStr <> "" Then
MsgBox "Following are the activities which are already been updated in MAR:" & vbNewLine & vbNewLine & DuplicateStr & vbNewLine & vbNewLine & "Please Cross-check, Thank you", vbExclamation + vbOKOnly, "Duplicate Activities"
End If
MsgBox "All the Activities have been successfully added to MAR file." & vbCrLf & vbCrLf & "Please Cross-check, Thank you", vbInformation + vbOKOnly, "New Transitioned Activities"
ElseIf Z = 1 Then
With SATsht
.Activate
.AutoFilterMode = False
.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=2, Criteria1:="Deactivate Activity in the Master List"
End With
If SATsht.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
MsgBox "There are no activities under Deletions, please cross-check"
GoTo NextMARFilter
End If
Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
MARfile.Sheets(1).AutoFilterMode = False
For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
MARfile.Sheets(1).Activate
If MARfile.Sheets(1).AutoFilterMode = False Then
MARfile.Sheets(1).Range("A1").AutoFilter
End If
MARfile.Sheets(1).Range(Cells(1, MARCols), Cells(MARoldRows, MARCols)).AutoFilter field:=9, Criteria1:=EachActivity.Value
If MARfile.Sheets(1).AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
EachActivity.Font.Color = vbRed
GoTo NextEachActivity
End If
MARfile.Sheets(1).Range(Cells(1, 9).Offset(1), Cells(MARoldRows, 9)).SpecialCells(xlCellTypeVisible).Cells(1, 42).Value = "Inactive"
NextEachActivity:
MARfile.Sheets(1).ShowAllData
Next
ModificationsCount = TotalRng.SpecialCells(xlCellTypeVisible).Rows.Count
ElseIf Z = 2 Then
Set MDsht = MARfile.Sheets("Modified & Deleted Activities")
MDrows = MDsht.Range("A" & Rows.Count).End(xlUp).Row
MDcols = MDsht.Cells(657, Columns.Count).End(xlToLeft).Column
With SATsht
.Activate
.AutoFilterMode = False
.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=2, Criteria1:="Modify exisiting activity level details"
End With
If SATsht.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
MsgBox "There are no activities under Deletions, please cross-check"
GoTo NextMARFilter
End If
Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
MARfile.Sheets(1).AutoFilterMode = False
MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
MARfile.Sheets(1).Activate
If MARfile.Sheets(1).AutoFilterMode = False Then
MARfile.Sheets(1).Range("A1").AutoFilter
End If
MARfile.Sheets(1).Range(Cells(1, MARCols), Cells(MARoldRows, MARCols)).AutoFilter field:=9, Criteria1:=EachActivity.Value
If MARfile.Sheets(1).AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
EachActivity.Font.Color = vbRed
GoTo NextEachActivity1
End If
MARfile.Sheets(1).Range(Cells(1, "B").Offset(1), Cells(MARoldRows, "H")).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Copy
MDsht.Cells(MDrows + 1, "D").PasteSpecial xlPasteValues
MARfile.Sheets(1).Range(Cells(1, "I").Offset(1), Cells(MARoldRows, "AX")).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Copy
MDsht.Cells(MDrows + 1, "L").PasteSpecial xlPasteValues
MDsht.Range("A" & MDrows + 1).Value = MDrows + 1
MDsht.Range("C" & MDrows + 1).Value = "Modify exisiting activity level details"
MDsht.Cells(MDrows + 1, "BB").Value = Date & ": Modified as per the request received"
MDrows = MDsht.Range("A" & Rows.Count).End(xlUp).Row
MARfile.Sheets(1).Range(Cells(1, "B").Offset(1), Cells(MARoldRows, "H")).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Select
Selection.EntireRow.Delete xlUp
If MARfile.Sheets(1).AutoFilterMode = True Then
MARfile.Sheets(1).ShowAllData
Else
MARfile.Sheets(1).AutoFilter
End If
MARnewRows = MARfile.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
SATfile.Activate
If EachActivity.Offset(0, 1).Value <> "-" Or EachActivity.Offset(0, 1).Value = "" Then
SATsht.Range(Cells(EachActivity.Row, "E"), Cells(EachActivity.Row, "K")).Copy
MARfile.Sheets(1).Range("B" & MARnewRows + 1).PasteSpecial xlPasteValues
SATsht.Range(Cells(EachActivity.Row, "M"), Cells(EachActivity.Row, "R")).Copy
MARfile.Sheets(1).Range("I" & MARnewRows + 1).PasteSpecial xlPasteValues
SATsht.Range(Cells(EachActivity.Row, "S"), Cells(EachActivity.Row, "BA")).Copy
MARfile.Sheets(1).Range("P" & MARnewRows + 1).PasteSpecial xlPasteValues
Else
SATsht.Range(Cells(EachActivity.Row, "E"), Cells(EachActivity.Row, "L")).Copy
MARfile.Sheets(1).Range("B" & MARnewRows + 1).PasteSpecial xlPasteValues
SATsht.Range(Cells(EachActivity.Row, "N"), Cells(EachActivity.Row, "R")).Copy
MARfile.Sheets(1).Range("J" & MARnewRows + 1).PasteSpecial xlPasteValues
SATsht.Range(Cells(EachActivity.Row, "S"), Cells(EachActivity.Row, "BA")).Copy
MARfile.Sheets(1).Range("P" & MARnewRows + 1).PasteSpecial xlPasteValues
End If
NextEachActivity1:
MARfile.Sheets(1).Activate
On Error Resume Next
MARfile.Sheets(1).ShowAllData
On Error GoTo 0
Next
MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
MARnewRows = MARfile.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
For X = MARoldRows + 1 To MARnewRows
MARfile.Sheets(1).Range("D" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 2, 0)
Next X
For X = MARoldRows + 1 To MARnewRows
MARfile.Sheets(1).Range("E" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 3, 0)
Next X
MARheader = Application.WorksheetFunction.Match("Comments", MARheaderRng, 0)
MARfile.Sheets(1).Range(Cells(MARoldRows + 1, MARheader), Cells(MARnewRows, MARheader)).Value = "" & Format(Date, "mm/dd/yyyy") & ": Modified as per the request received"
MARheader = Application.WorksheetFunction.Match("S.No", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARheader = Application.WorksheetFunction.Match("Activity Code", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARheader = Application.WorksheetFunction.Match("Sub-Function Code", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARheader = Application.WorksheetFunction.Match("WBS Charge Code", MARheaderRng, 0)
MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
MARfile.Sheets(1).Range(Cells(1, 1), Cells(MARnewRows, MARCols)).Borders.LineStyle = xlContinuous
On Error Resume Next
MARfile.Sheets(1).ShowAllData
On Error GoTo 0
End If
NextMARFilter:
Next Z
MsgBox "Activities have been Added/Modified as per the requirements." & vbNewLine & vbNewLine & _
"Any activity that is highlighted in RED in Standard Template represent the following:" & vbCrLf & vbCrLf & _
"1. Addtions: Activities that are already available" & vbNewLine & _
"2. Modifications: Activities are not available to modify." & vbNewLine & _
"3. Deletions: Activities are not available to delete." & vbNewLine & vbNewLine & _
"Please cross-check, Thank you.", vbInformation + vbOKOnly, "MAR Modifications"
End Sub