Hello,
The code below runs as it should, but I need this code to run only for cells where the data in Sheet1 (Sheet name doesn't matter because I can update that as needed) Column D is blank.
So if cell value on column D7 is blank, then run the code, but if the value in cell D8 has a date, then skip the code.
For any cell in D7 down to last row of data that has a date, then I will need the cell value from AN-AR to remain as is (do not update these values). But if there is no date in any cell from D7 down to last row of data, then run the code. I need to write a trap within the 'Alignment' Sub.
How can I accomplish this?
The code below runs as it should, but I need this code to run only for cells where the data in Sheet1 (Sheet name doesn't matter because I can update that as needed) Column D is blank.
So if cell value on column D7 is blank, then run the code, but if the value in cell D8 has a date, then skip the code.
For any cell in D7 down to last row of data that has a date, then I will need the cell value from AN-AR to remain as is (do not update these values). But if there is no date in any cell from D7 down to last row of data, then run the code. I need to write a trap within the 'Alignment' Sub.
How can I accomplish this?
VBA Code:
Sub Alignment()
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
app_functions_OFF
'Managed Segment
MSHomeNodeNumber
MSImpactedNodeNumber
MSHierarchyHome2
'MSHierarchyHome
MSHierarchyImpacted2
'MSHierarchyImpacted
BusinessL1
BusinessL2
BusinessL3
BusinessL4
'Sector
MSHomeNodeNumberSector
MSImpactedNodeNumberSector
MSHierarchyHomeSector
MSHierarchyImpactedSector
BusinessL1Sector
BusinessL2Sector
BusinessL3Sector
BusinessL4Sector
'Accountable Executive
AcctExec
AcctExecSector
'Alignment
Ownership
L1_Area
L2_Business
BusImp
CleanUpBusImp
L3Region
app_functions_ON
'Determine how many seconds code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes/seconds", vbInformation
End Sub
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub app_functions_OFF()
'Turn off excel features to speed up calculations
Application.Calculation = xlManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
End Sub
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub app_functions_ON()
'Turn on excel features to speed up calculations
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayStatusBar = True
End Sub
Sub MSHomeNodeNumber()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
RX.Pattern = "(^|\D)(\d+)(\D|$)"
With Sheets("Admin_Drop_Downs")
a = .Range("BH2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 4)
Next i
With Sheets("Audit_Plan")
a = .Range("T7", .Range("T" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
For Each M In RX.Execute(a(i, 1))
If D.exists(M.submatches(1)) Then
If Not d2.exists(M.submatches(1)) Then
d2(M.submatches(1)) = 1
B(i, 1) = RemoveDupes(IIf(IsEmpty(B(i, 1)), "", B(i, 1) & "/") & D(M.submatches(1)), "/")
End If
End If
Next M
Next i
Sheets("Main").Range("A3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSImpactedNodeNumber()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
RX.Pattern = "(^|\D)(\d+)(\D|$)"
With Sheets("Admin_Drop_Downs")
a = .Range("BH2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 4)
Next i
With Sheets("Audit_Plan")
a = .Range("V7", .Range("V" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
For Each M In RX.Execute(a(i, 1))
If D.exists(M.submatches(1)) Then
If Not d2.exists(M.submatches(1)) Then
d2(M.submatches(1)) = 1
B(i, 1) = RemoveDupes(IIf(IsEmpty(B(i, 1)), "", B(i, 1) & "/") & D(M.submatches(1)), "/")
End If
End If
Next M
Next i
Sheets("Main").Range("C3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHierarchyHome2()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
'RX.Pattern = "(^|\D)(\d+)(\D|$)"
RX.Pattern = "(^|\D)(\d{2,10})(\D|$)"
With Sheets("Admin_Drop_Downs")
a = .Range("BH2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 4)
Next i
With Sheets("Audit_Plan")
a = .Range("U7", .Range("U" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
For Each M In RX.Execute(a(i, 1))
If D.exists(M.submatches(1)) Then
If Not d2.exists(M.submatches(1)) Then
d2(M.submatches(1)) = 1
B(i, 1) = RemoveDupes(IIf(IsEmpty(B(i, 1)), "", B(i, 1) & "/") & D(M.submatches(1)), "/")
End If
End If
Next M
Next i
Sheets("Main").Range("B3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHierarchyHome()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("U7", .Range("U" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("B3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHierarchyImpacted()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("W7", .Range("W" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("D3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHierarchyImpacted2()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
'RX.Pattern = "(^|\D)(\d+)(\D|$)"
RX.Pattern = "(^|\D)(\d{2,10})(\D|$)"
With Sheets("Admin_Drop_Downs")
a = .Range("BH2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 4)
Next i
With Sheets("Audit_Plan")
a = .Range("W7", .Range("W" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
For Each M In RX.Execute(a(i, 1))
If D.exists(M.submatches(1)) Then
If Not d2.exists(M.submatches(1)) Then
d2(M.submatches(1)) = 1
B(i, 1) = RemoveDupes(IIf(IsEmpty(B(i, 1)), "", B(i, 1) & "/") & D(M.submatches(1)), "/")
End If
End If
Next M
Next i
Sheets("Main").Range("D3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL1()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("O7", .Range("O" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("E3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL2()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("P7", .Range("P" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("F3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL3()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("Q7", .Range("Q" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("G3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL4()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BK" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("R7", .Range("R" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("H3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHomeNodeNumberSector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
RX.Pattern = "(^|\D)(\d+)(\D|$)"
With Sheets("Admin_Drop_Downs")
a = .Range("BH2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("T7", .Range("T" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
For Each M In RX.Execute(a(i, 1))
If D.exists(M.submatches(1)) Then
If Not d2.exists(M.submatches(1)) Then
d2(M.submatches(1)) = 1
B(i, 1) = RemoveDupes(IIf(IsEmpty(B(i, 1)), "", B(i, 1) & "/") & D(M.submatches(1)), "/")
End If
End If
Next M
Next i
Sheets("Main").Range("I3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSImpactedNodeNumberSector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
RX.Pattern = "(^|\D)(\d+)(\D|$)"
With Sheets("Admin_Drop_Downs")
a = .Range("BH2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 3)
Next i
With Sheets("Audit_Plan")
a = .Range("V7", .Range("V" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
For Each M In RX.Execute(a(i, 1))
If D.exists(M.submatches(1)) Then
If Not d2.exists(M.submatches(1)) Then
d2(M.submatches(1)) = 1
B(i, 1) = RemoveDupes(IIf(IsEmpty(B(i, 1)), "", B(i, 1) & "/") & D(M.submatches(1)), "/")
End If
End If
Next M
Next i
Sheets("Main").Range("K3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHierarchyHomeSector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("U7", .Range("U" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("J3").Resize(UBound(B)).Value = B
End With
End Sub
Sub MSHierarchyImpactedSector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("W7", .Range("W" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("L3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL1Sector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("O7", .Range("O" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("M3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL2Sector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("P7", .Range("P" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("N3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL3Sector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("Q7", .Range("Q" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("O3").Resize(UBound(B)).Value = B
End With
End Sub
Sub BusinessL4Sector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = Join(Application.Transpose(.Range("BI2", .Range("BI" & Rows.Count).End(xlUp)).Value), "|")
RX.Pattern = "(\b)(" & Replace(Replace(Replace(Replace(RX.Pattern, "[", "\["), "]", "\]"), "(", "\("), ")", "\)") & ")"
a = .Range("BI2", .Range("BJ" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("R7", .Range("R" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("P3").Resize(UBound(B)).Value = B
End With
End Sub
Sub AcctExec()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = "(^|\D)(^|\D)(\d+)"
a = .Range("BR2", .Range("BU" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 4)
Next i
With Sheets("Audit_Plan")
a = .Range("AB7", .Range("AB" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Replace(Mid(s, 2), "EO&T - Head", "")
Next i
Sheets("Main").Range("Q3").Resize(UBound(B)).Value = B
End With
'Clean up data
For Each rng In Range("Q:Q")
If Right(Trim(rng.Value), 1) = "/" Then
rng.Value = Left(Trim(rng.Value), Len(Trim(rng.Value)) - 1)
End If
Next
For Each rng In Range("Q:Q")
If Left(Trim(rng.Value), 1) = "/" Then
rng.Value = Right(Trim(rng.Value), Len(Trim(rng.Value)) - 1)
End If
Next
End Sub
Sub AcctExecSector()
Dim RX As Object, M As Object, D As Object, d2 As Object
Dim a As Variant, B As Variant
Dim i As Long
Dim s As String, sM As String
Set D = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
With Sheets("Admin_Drop_Downs")
RX.Pattern = "(^|\D)(^|\D)(\d+)"
a = .Range("BR2", .Range("BS" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(a)
D(CStr(a(i, 1))) = a(i, 2)
Next i
With Sheets("Audit_Plan")
a = .Range("AB7", .Range("AB" & Rows.Count).End(xlUp)).Value
ReDim B(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
d2.RemoveAll
s = vbNullString
For Each M In RX.Execute(a(i, 1))
sM = M
If Not d2.exists(D(sM)) Then
s = s & "/" & D(sM)
d2(D(sM)) = 1
End If
Next M
B(i, 1) = Mid(s, 2)
Next i
Sheets("Main").Range("R3").Resize(UBound(B)).Value = B
End With
'Clean up data
For Each rng In Range("R:R")
If Right(Trim(rng.Value), 1) = "/" Then
rng.Value = Left(Trim(rng.Value), Len(Trim(rng.Value)) - 1)
End If
Next
For Each rng In Range("R:R")
If Left(Trim(rng.Value), 1) = "/" Then
rng.Value = Right(Trim(rng.Value), Len(Trim(rng.Value)) - 1)
End If
Next
End Sub
Sub Ownership()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim i&, rngD, rngB, rngC, B As String, C As String, D As String, Ownership()
Set sh = Sheets("Main")
Set sh2 = Sheets("Audit_Plan")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("J" & Rows.Count).End(xlUp).Row
rngD = sh.Range("Q3:Q" & lr).Value: rngB = sh.Range("A3:A" & lr).Value: rngC = sh.Range("B3:B" & lr).Value
ReDim Ownership(1 To UBound(rngB), 1 To 1)
For i = 1 To UBound(rngB)
D = rngD(i, 1): B = rngB(i, 1): C = rngC(i, 1)
Select Case True
Case D Like "*Non-O&T Business*"
Ownership(i, 1) = "Non-O&T"
Case Not (D Like "*Non-O&T Business*") And D <> ""
Ownership(i, 1) = "O&T Area"
Case D = ""
If B Like "*Non-O&T Business*" Or B = "" Or C Like "*Non-O&T Business*" Or C = "" Then
Ownership(i, 1) = "Non-O&T"
Else
Ownership(i, 1) = "O&T Area"
End If
End Select
Next
With sh2.Range("AN7").Resize(UBound(rngB), 1)
.ClearContents
.Value = Ownership
End With
End Sub
Sub L1_Area()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim i&, rngD, rngB, rngC, rngE, rngF, rngG, rngH, rngJ, rngM, B As String, C As String, D As String, E As String, F As String, G As String, H As String, j As String, M As String, BusImp()
Set sh = Sheets("Main")
Set sh2 = Sheets("Audit_Plan")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("J" & Rows.Count).End(xlUp).Row
rngD = sh.Range("Q3:Q" & lr).Value: rngB = sh.Range("A3:A" & lr).Value: rngC = sh.Range("B3:B" & lr).Value: rngE = sh2.Range("AN7:AN" & lr2).Value: rngF = sh2.Range("AO7:AO" & lr2).Value: rngG = sh.Range("C3:C" & lr).Value: rngH = sh.Range("D3:D" & lr).Value: rngJ = sh2.Range("AR7:AR" & lr2).Value: rngM = sh2.Range("K7:K" & lr2).Value
ReDim L1_Area(1 To UBound(rngB), 1 To 1)
For i = 1 To UBound(rngB)
E = rngE(i, 1): D = rngD(i, 1): B = rngB(i, 1): C = rngC(i, 1): F = rngF(i, 1): G = rngG(i, 1): H = rngH(i, 1): M = rngM(i, 1)
Select Case True
Case (E Like "Non-O&T")
If (D = "Non-O&T Business" Or D = "") And (B = "Non-O&T Business" Or B = "") And (C = "Non-O&T Business" Or C = "") And (G = "Non-O&T Business" Or G = "") And (H = "Non-O&T Business" Or H = "") Then
L1_Area(i, 1) = "Business"
Else
L1_Area(i, 1) = "Shared Non-O&T"
End If
End Select
Select Case True
Case (E Like "O&T Area")
'Code for only 1 business in Accountable Executive
If D = "CTI" Or D = "GFT" Or D = "CISO" Or D = "PBWM Technology" Or D = "LF - PBWM Technology" Or D = "ICG Technology" Then
L1_Area(i, 1) = "Technology"
ElseIf F Like "*ICG Technology*" Or F Like "*PBWM Technology*" Then
L1_Area(i, 1) = "Technology"
ElseIf D = "CAO" Or D = "COO" Or D = "Operational Excellence" Or D = "GBS" Or D = "Business Simplification" Or D = "CSS" Or D = "Enterprise Architecture" Then
L1_Area(i, 1) = "Other O&T Units"
ElseIf D = "PBWM Operations" Or D = "LF - PBWM Operations" Or D = "ICG Operations" Then
L1_Area(i, 1) = "Operations"
'Code for Multiple businesses
ElseIf D Like "*CTI*" Or D Like "*GFT*" Like D Like "*CISO*" Or D Like "*PBWM Technology*" Or D Like "*LF - PBWM Technology*" Or D Like "*ICG Technology*" Then
L1_Area(i, 1) = "Technology"
ElseIf D Like "*CAO*" Or D Like "*COO*" Or D Like "*Operational Excellence*" Or D Like "*GBS*" Or D Like "*Business Simplification*" Or D Like "*CSS*" Or D = "*Enterprise Architecture*" Then
L1_Area(i, 1) = "Other O&T Units"
ElseIf D Like "*PBWM Operations*" Or D Like "*LF - PBWM Operations*" Or D Like "*ICG Operations*" Then
L1_Area(i, 1) = "Operations"
'Code for only 1 business in Managed Segment (Home) Node Number
ElseIf D = "" Then
If B = "CTI" Or B = "GFT" Or B = "CISO" Or B = "PBWM Technology" Or B = "LF - PBWM Technology" Or B = "ICG Technology" Then
L1_Area(i, 1) = "Technology"
ElseIf F Like "*ICG Technology*" Or F Like "*PBWM Technology*" Then
L1_Area(i, 1) = "Technology"
ElseIf B = "CAO" Or B = "COO" Or B = "Operational Excellence" Or B = "GBS" Or B = "Business Simplification" Or B = "CSS" Or B = "Enterprise Architecture" Then
L1_Area(i, 1) = "Other O&T Units"
ElseIf B = "CTI" Or B = "PBWM Operations" Or B = "LF - PBWM Operations" Or B = "ICG Operations" Then
L1_Area(i, 1) = "Operations"
'Code for Multiple businesses
ElseIf B Like "*CTI*" Or B Like "*GFT*" Or B Like "*CISO*" Or B Like "*PBWM Technology*" Or B Like "*LF - PBWM Technology*" Or B Like "*ICG Technology*" Then
L1_Area(i, 1) = "Technology"
ElseIf B Like "*CAO*" Or B Like "*COO*" Or B Like "*Operational Excellence*" Or B Like "*GBS*" Or B Like "*Business Simplification*" Or B Like "*CSS*" Or B Like "*Enterprise Architecture*" Then
L1_Area(i, 1) = "Other O&T Units"
ElseIf B Like "*CTI*" Or B Like "*PBWM Operations*" Or B Like "*LF - PBWM Operations*" Or B Like "*ICG Operations*" Then
L1_Area(i, 1) = "Operations"
End If
'Code for Auidt Title identification
ElseIf M Like "*ICG Technology*" Then
L1_Area(i, 1) = "Technology"
ElseIf M Like "*PBWM Technology*" Then
L1_Area(i, 1) = "Technology"
End If
'End If
End Select
Next
With sh2.Range("AO7").Resize(UBound(rngB), 1)
.ClearContents
.Value = L1_Area
End With
End Sub
Sub L2_Business()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim i&, rngD, rngB, rngC, rngE, rngF, B As String, C As String, D As String, E As String, F As String, L2_Business()
Set sh = Sheets("Main")
Set sh2 = Sheets("Audit_Plan")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("J" & Rows.Count).End(xlUp).Row
rngD = sh.Range("Q3:Q" & lr).Value: rngB = sh.Range("A3:A" & lr).Value: rngC = sh.Range("B3:B" & lr).Value: rngE = sh2.Range("AN7:AN" & lr2).Value: rngF = sh2.Range("K7:K" & lr2).Value
ReDim L2_Business(1 To UBound(rngB), 1 To 1)
For i = 1 To UBound(rngB)
E = rngE(i, 1): D = rngD(i, 1): B = rngB(i, 1): C = rngC(i, 1): F = rngF(i, 1)
Select Case True
Case (E Like "O&T Area")
If D = "CAO" Or D = "COO" Or D = "Operational Excellence" Or D = "GBS" Or D = "Business Simplification" Or D = "CSS" Or D = "Enterprise Architecture" Then
L2_Business(i, 1) = D
ElseIf D = "CTI" Or D = "GFT" Or D = "CISO" Or D = "PBWM Technology" Or D = "LF - PBWM Technology" Or D = "ICG Technology" Then
L2_Business(i, 1) = D
ElseIf D = "CTI" Or D = "PBWM Operations" Or D = "LF - PBWM Operations" Or D = "ICG Operations" Then
L2_Business(i, 1) = D
'This part of code works
ElseIf D = "" Then
If B = "CAO" Or B = "COO" Or B = "Operational Excellence" Or B = "GBS" Or B = "Business Simplification" Or B = "CSS" Or B = "Enterprise Architecture" Then
L2_Business(i, 1) = B
ElseIf B = "CTI" Or B = "GFT" Or B = "CISO" Or B = "PBWM Technology" Or B = "LF - PBWM Technology" Or B = "ICG Technology" Then
L2_Business(i, 1) = B
ElseIf B = "CTI" Or B = "PBWM Operations" Or B = "LF - PBWM Operations" Or B = "ICG Operations" Then
L2_Business(i, 1) = B
Else
L2_Business(i, 1) = "Multi O&T Businesses"
End If
'Code for Audit Title identification Check
ElseIf F Like "*ICG Technology*" Then
L2_Business(i, 1) = "ICG Technology"
ElseIf F Like "*PBWM Technology*" Then
L2_Business(i, 1) = "PBWM Technology"
'Everything else is Multi
Else
L2_Business(i, 1) = "Multi O&T Businesses"
End If
End Select
Next
With sh2.Range("AP7").Resize(UBound(rngB), 1)
.ClearContents
.Value = L2_Business
End With
End Sub
Sub BusImp()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim i&, rngD, rngB, rngC, rngE, rngF, rngG, rngH, rngJ, B As String, C As String, D As String, E As String, F As String, G As String, H As String, j As String, BusImp()
Set sh = Sheets("Main")
Set sh2 = Sheets("Audit_Plan")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("J" & Rows.Count).End(xlUp).Row
rngD = sh.Range("Q3:Q" & lr).Value: rngB = sh.Range("A3:A" & lr).Value: rngC = sh.Range("B3:B" & lr).Value: rngE = sh2.Range("AN7:AN" & lr2).Value: rngF = sh2.Range("AO7:AO" & lr2).Value: rngG = sh.Range("C3:C" & lr).Value: rngH = sh.Range("D3:D" & lr).Value: rngJ = sh2.Range("AR7:AR" & lr2).Value
ReDim BusImp(1 To UBound(rngB), 1 To 1)
For i = 1 To UBound(rngB)
F = rngF(i, 1): D = rngD(i, 1): B = rngB(i, 1): C = rngC(i, 1): E = rngE(i, 1): G = rngG(i, 1): H = rngH(i, 1): j = rngJ(i, 1)
Select Case True
'Code Business Impacted Code for Shared Audits
Case (F Like "Shared Non-O&T")
BusImp(i, 1) = RemoveDupes(Replace(Replace(Replace(D & "/" & B & "/" & C & "/" & G & "/" & H, "Non-O&T Business", ""), "///", "/"), "//", "/"), "/")
End Select
Select Case True
Case (E Like "O&T Area")
'BusImp(i, 1) = RemoveDupes(Replace(Replace(Replace(D & "/" & b & "/" & C & "/" & G & "/" & H, "Non-O&T Business", ""), "///", "/"), "//", "/"), "/")
BusImp(i, 1) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(RemoveDupes(Replace(Replace(Replace(D & "/" & B & "/" & C & "/" & G & "/" & H, "Non-O&T Business", ""), "///", "/"), "//", "/"), "/"), "/EO&T", ""), "/LF - PBWM O&T", ""), "LF - PBWM O&T/", ""), "/PBWM O&T", ""), "/ICG O&T", ""), "ICG O&T/", ""), "PBWM O&T/", ""), "EO&T/", "")
End Select
Next
With sh2.Range("AR7").Resize(UBound(rngF), 1)
.ClearContents
.Value = BusImp
End With
End Sub
Sub CleanUpBusImp()
Dim sh As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim i&, rngF, rngZ, rngK, rngE, F As String, Z As String, K As String, E As String, CleanBusImp()
Set sh = Sheets("Main")
Set sh2 = Sheets("Audit_Plan")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("J" & Rows.Count).End(xlUp).Row
rngF = sh2.Range("AO7:AO" & lr2).Value: rngZ = sh2.Range("AR7:AR" & lr2).Value: rngK = sh2.Range("AP7:AP" & lr2).Value: rngE = sh2.Range("AN7:AN" & lr2).Value
ReDim CleanBusImp(1 To UBound(rngZ), 1 To 1)
For i = 1 To UBound(rngZ)
F = rngF(i, 1): Z = rngZ(i, 1): K = rngK(i, 1): E = rngE(i, 1)
Select Case True
Case (F Like "Shared Non-O&T")
CleanBusImp(i, 1) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Z, "/EO&T", ""), "/LF - PBWM O&T", ""), "LF - PBWM O&T/", ""), "/PBWM O&T", ""), "/ICG O&T", ""), "ICG O&T/", ""), "PBWM O&T/", ""), "EO&T/", "")
If Z = "LF - PBWM O&T" Then
CleanBusImp(i, 1) = "LF - PBWM Operations/LF - PBWM Technology"
ElseIf Z = "PBWM O&T" Then
CleanBusImp(i, 1) = "PBWM Operations/PBWM Technology"
ElseIf Z = "ICG O&T" Then
CleanBusImp(i, 1) = "ICG Operations/ICG Technology"
ElseIf Z = "EO&T" Then
F = Replace(F, "Shared Non-O&T", "Business")
CleanBusImp(i, 1) = ""
End If
End Select
Select Case True
Case (E Like "O&T Area")
'Code to remove L2_Business from Busines Impacted if exact match
If (K = "CTI") And (Z = "CTI") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "CAO") And (Z = "CAO") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "CISO") And (Z = "CISO") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "COO") And (Z = "COO") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "CSS") And (Z = "CSS") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "GFT") And (Z = "GFT") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "Operational Excellence") And (Z = "Operational Excellence") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "Enterprise Architecture") And (Z = "Enterprise Architecture") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "EO&T GBS") And (Z = "EO&T GBS") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "ICG Operations") And (Z = "ICG Operations") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "ICG Technology") And (Z = "ICG Technology") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "LF - PBWM Operations") And (Z = "LF - PBWM Operations") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "LF - PBWM Technology") And (Z = "LF - PBWM Technology") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "PBWM Operations") And (Z = "PBWM Operations") Then
CleanBusImp(i, 1) = ""
ElseIf (K = "PBWM Technology") And (Z = "PBWM Technology") Then
CleanBusImp(i, 1) = ""
'Code to remove L2_Business from Busines Impacted with multiple businesses ... removing just teh line of businesses that is marked as being the audit owner
ElseIf (K = "CTI") And (Z Like "*CTI*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/CTI", ""), "CTI/", "")
ElseIf (K = "CAO") And (Z Like "*CAO*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/CAO", ""), "CAO/", "")
ElseIf (K = "CISO") And (Z Like "*CISO*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/CISO", ""), "CISO/", "")
ElseIf (K = "COO") And (Z Like "*COO*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/COO", ""), "COO/", "")
ElseIf (K = "CSS") And (Z Like "*CSS*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/CSS", ""), "CSS/", "")
ElseIf (K = "GFT") And (Z Like "*GFT*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/GFT", ""), "GFT/", "")
ElseIf (K = "Operational Excellence") And (Z Like "Operational Excellence") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/Operational Excellence", ""), "Operational Excellence/", "")
ElseIf (K = "Enterprise Architecture") And (Z Like "*Enterprise Architecture*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/Enterprise Architecture", ""), "Enterprise Architecture/", "")
ElseIf (K = "EO&T GBS") And (Z Like "*EO&T GBS*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/EO&T GBS", ""), "EO&T GBS/", "")
ElseIf (K = "ICG Operations") And (Z Like "*ICG Operations*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/ICG Operations", ""), "ICG Operations/", "")
ElseIf (K = "ICG Technology") And (Z Like "*ICG Technology*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/ICG Technology", ""), "ICG Technology/", "")
ElseIf (K = "LF - PBWM Operations") And (Z Like "*LF - PBWM Operations*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/LF - PBWM Operations", ""), "LF - PBWM Operations/", "")
ElseIf (K = "LF - PBWM Technology") And (Z Like "*LF - PBWM Technology*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/LF - PBWM Technology", ""), "LF - PBWM Technology/", "")
ElseIf (K = "PBWM Operations") And (Z Like "/PBWM Operations*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/PBWM Operations", ""), "PBWM Operations/", "")
ElseIf (K = "PBWM Technology") And (Z Like "/PBWM Technology*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/PBWM Technology", ""), "PBWM Technology/", "")
ElseIf (K = "PBWM Technology") And (Z Like "/PBWM Technology*") Then
CleanBusImp(i, 1) = Replace(Replace(Z, "/PBWM Technology", ""), "PBWM Technology/", "")
ElseIf (K = "Multi O&T Businesses") Then
CleanBusImp(i, 1) = Z
End If
End Select
Next
With sh2.Range("AR7").Resize(UBound(rngZ), 1)
.ClearContents
.Value = CleanBusImp
End With
End Sub
Sub L3Region()
Dim sh As Worksheet
Dim lr As Long
Dim i&, rngD, rngB, B As String, D As String, L3Region()
Set sh = Sheets("Audit_Plan")
lr = sh.Range("J" & Rows.Count).End(xlUp).Row
rngD = sh.Range("AN7:AN" & lr).Value: rngB = sh.Range("AT7:AT" & lr).Value
ReDim L3Region(1 To UBound(rngB), 1 To 1)
For i = 1 To UBound(rngB)
D = rngD(i, 1): B = rngB(i, 1)
Select Case True
Case D = "O&T Area"
L3Region(i, 1) = B
End Select
Next
With sh.Range("AQ7").Resize(UBound(rngB), 1)
.ClearContents
.Value = L3Region
End With
End Sub
Function RemoveDupes(txt As String, Optional delim As String = "/") As String
Dim x
'Updateby Extendoffice
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each x In Split(txt, delim)
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Next
If .Count > 0 Then RemoveDupes = Join(.keys, delim)
End With
End Function
