Hello,
i have the below code that runs, but the only issue I have is that it takes about 30 minutes to complete/ any ideas on how i can get it to run quicker?
Thank you,
i have the below code that runs, but the only issue I have is that it takes about 30 minutes to complete/ any ideas on how i can get it to run quicker?
VBA Code:
Sub HierarchyAutomation()
Dim sh1 As Worksheet
Dim dic As Object, dic2 As Object, dic4 As Object, dicar1 As Object, dicar3 As Object, dicar5 As Object
Dim i As Long, j As Long
Dim lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long, cola As Long, colb As Long
Dim a As Variant, C As Variant, E As Variant
Dim b1 As Variant, b2 As Variant, b3 As Variant, b4 As Variant, b5 As Variant, b6 As Variant, b7 As Variant, b8 As Variant, b9 As Variant, b10 As Variant
Dim ar1 As Variant, ar3 As Variant, ar5 As Variant
Dim lv As String, lv2 As Variant, lv3 As Variant, lv4 As Variant
Set sh1 = Sheets("DSMT")
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
Set dic4 = CreateObject("Scripting.Dictionary")
Set dicar1 = CreateObject("Scripting.Dictionary")
Set dicar3 = CreateObject("Scripting.Dictionary")
Set dicar5 = CreateObject("Scripting.Dictionary")
'data Mapping
lr1 = sh1.Range("GT" & Rows.Count).End(xlUp).Row
b1 = sh1.Range("HL3:HL" & lr1).Value 'Managed Segment (Home)- NodeNumber
b3 = sh1.Range("IY3:IY" & lr1).Value 'Managed Segment (Impacted)-Node Number
b5 = sh1.Range("KM3:KM" & lr1).Value 'Accountable Executive
b7 = sh1.Range("IE3:IE" & lr1).Value 'Managed Segment Hierarchy (Home)
b9 = sh1.Range("JS3:JS" & lr1).Value 'Managed Segment Hierarchy (Impacted)
ReDim b2(1 To lr1 - 2, 1 To 17) 'result
ReDim b4(1 To lr1 - 2, 1 To 17) 'result
ReDim b6(1 To lr1 - 2, 1 To 17) 'result
ReDim b8(1 To lr1 - 2, 1 To 17) 'result
ReDim b10(1 To lr1 - 2, 1 To 17) 'result
ar1 = Array("", "AC", "F", "U", "K", "P", "AE", "CC", "AJ", "BN", "A", "BS", "BX", "AO", "AT", "BI", "AY", "BD") 'MS ID Level columns
For i = 1 To UBound(ar1)
'stores position 1, 2, 3... and its respective search column
dicar1(Columns(ar1(i)).Column) = i
Next
ar3 = Array("", "DK", "DW", "DE", "CS", "CY", "DQ", "FM", "EC", "FS", "CM", "FY", "GE", "EI", "EO", "EU", "FA", "FG") 'SOEID Columns
For i = 1 To UBound(ar3)
'stores position 1, 2, 3... and its respective search column
dicar3(Columns(ar3(i)).Column) = i
Next
'ar5 = Array("", "AA", "G", "V", "L", "Q", "AF", "CD", "AK", "BO", "B", "BT", "BY", "AP", "AU", "BJ", "AZ", "BE") 'MS ID Name
'For i = 1 To UBound(ar5)
'stores position 1, 2, 3... and its respective search column
' dicar5(Columns(ar5(i)).Column) = i
'Next
'data DSMT - Managed Segment ID Range
lr2 = sh1.Cells.Find("*", , xlValues, xlPart, , xlPrevious).Row
'lr4 = sh1.Cells.Find("*", , xlValues, xlPart, , xlPrevious).Row
a = sh1.Range("A4", sh1.Range("CC" & lr2)).Value
'e = sh1.Range("A4", sh1.Range("CF" & lr4)).Value
'stores MS_Level_ID in dictionary and the column to which it belongs
For j = 1 To UBound(a, 2) Step 3
For i = 1 To UBound(a, 1)
If a(i, j) = "" Then Exit For
dic(a(i, j)) = j + 0 'move 0 because start in column A
Next
Next
' 'stores MS_Level_Name in dictionary and the column to which it belongs
' For j = 1 To UBound(e, 2) Step 3
' For i = 1 To UBound(e, 1)
' If e(i, j) = "" Then Exit For
' dic4(e(i, j)) = j + 1 'move 1 because start in column B
' Next
' Next
'check column "HL" - Managed Segment (Home)- NodeNumber
For i = 1 To UBound(b1, 1)
lv = Replace(b1(i, 1), ")", "(")
lv2 = Split(lv, "(")
For Each lv2 In Split(lv, "(")
If dic.exists("(" & lv2 & ")") Then
cola = dic("(" & lv2 & ")") 'gets column to which it belongs
colb = dicar1(cola) 'gets the column where the x is to be placed
b2(i, colb) = "X"
End If
Next
Next
'check column "IY" - Managed Segment (Impacted)-Node Number
For i = 1 To UBound(b3, 1)
lv = Replace(b3(i, 1), ")", "(")
lv2 = Split(lv, "(")
For Each lv2 In Split(lv, "(")
If dic.exists("(" & lv2 & ")") Then
cola = dic("(" & lv2 & ")") 'gets column to which it belongs
colb = dicar1(cola) 'gets the column where the x is to be placed
b4(i, colb) = "X"
End If
Next
Next
'check column "IE" - Managed Segment Hierarchy (Home)
' For i = 1 To UBound(b7, 1)
' lv4 = Split(b7, "--")
' For Each lv4 In Split(b7, "--")
' If dic4.exists(lv4) Then
' cola = dic4(lv4)
' colb = dicar5(cola)
' b7(i, colb) = "X"
' End If
' Next
' Next
'check column "JS" - Managed Segment Hierarchy (Impacted)
' For i = 1 To UBound(b9, 1)
' lv3 = Replace(b9(i, 1), "--", "--")
' lv4 = Split(lv3, "--")
' For Each lv4 In Split(lv3, "--")
' If dic4.exists("--" & lv4 & "--") Then
' cola = dic4("--" & lv4 & "--") 'gets column to which it belongs
' colb = dicar5(cola) 'gets the column where the x is to be placed
' b9(i, colb) = "X"
' End If
' Next
' Next
'data DSMT-SOEID List
lr3 = sh1.Cells.Find("*", , xlValues, xlPart, , xlPrevious).Row
C = sh1.Range("CM4", sh1.Range("GE" & lr3)).Value
'stores MS_Level_ID in dictionary and the column to which it belongs
For j = 1 To UBound(C, 2) Step 3
For i = 1 To UBound(C, 1)
If C(i, j) = "" Then Exit For
dic2(C(i, j)) = j + 90 'more 90 because start in column CM
Next
Next
'check column "KM"
For i = 1 To UBound(b5, 1)
lv = Replace(b5(i, 1), ")", "(")
lv2 = Split(lv, "(")
For Each lv2 In Split(lv, "(")
If dic2.exists("(" & lv2 & ")") Then
cola = dic2("(" & lv2 & ")") 'gets column to which it belongs
colb = dicar3(cola) 'gets the column where the x is to be placed
b6(i, colb) = "X"
End If
Next
Next
sh1.Range("GU3").Resize(UBound(b2, 1), UBound(b2, 2)).Value = b2
sh1.Range("IH3").Resize(UBound(b4, 1), UBound(b4, 2)).Value = b4
sh1.Range("JV3").Resize(UBound(b6, 1), UBound(b6, 2)).Value = b6
'Define Variables
Dim lrow As Long
lrow = Range("GT" & Rows.Count).End(xlUp).Row
'Disbale Excel properties while macrro runs
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Formula to Flag Managed Segment Hierarchy (Home)
Range("HN3:HN" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_CTI&""*"")),""X"","""")"
Range("HO3:HO" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_CAO&""*"")),""X"","""")"
Range("HP3:HP" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_CSS&""*"")),""X"","""")"
Range("HQ3:HQ" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_CISO&""*"")),""X"","""")"
Range("HR3:HR" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_COO&""*"")),""X"","""")"
Range("HS3:HS" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_Chng_Mngmnt&""*"")),""X"","""")"
Range("HT3:HT" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_Other&""*"")),""X"","""")"
Range("HU3:HU" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_GFT&""*"")),""X"","""")"
Range("HV3:HV" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_OpExcellence&""*"")),""X"","""")"
Range("HW3:HW" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_Business_Simplification&""*"")),""X"","""")"
Range("HX3:HX" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_PBWM_Ops&""*"")),""X"","""")"
Range("HY3:HY" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_PBWM_Tech&""*"")),""X"","""")"
Range("HZ3:HZ" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_NAme_ICG_Ops&""*"")),""X"","""")"
Range("IA3:IA" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_ICG_Tech&""*"")),""X"","""")"
Range("IB3:IB" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_Business&""*"")),""X"","""")"
Range("IC3:IC" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_LF_PBWM_Ops&""*"")),""X"","""")"
Range("ID3:ID" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC239,""*""&MS_ID_Name_LF_PBWM_Tech&""*"")),""X"","""")"
'Formula to Flag Managed Segment Hierarchy (Impacted)
Range("JB3:JB" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_CTI&""*"")),""X"","""")"
Range("JC3:JC" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_CAO&""*"")),""X"","""")"
Range("JD3:JD" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_CSS&""*"")),""X"","""")"
Range("JE3:JE" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_CISO&""*"")),""X"","""")"
Range("JF3:JF" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_COO&""*"")),""X"","""")"
Range("JG3:JG" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_Chng_Mngmnt&""*"")),""X"","""")"
Range("JH3:JH" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_Other&""*"")),""X"","""")"
Range("JI3:JI" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_GFT&""*"")),""X"","""")"
Range("JJ3:JJ" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_OpExcellence&""*"")),""X"","""")"
Range("JK3:JK" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_Business_Simplification&""*"")),""X"","""")"
Range("JL3:JL" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_PBWM_Ops&""*"")),""X"","""")"
Range("JM3:JM" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_PBWM_Tech&""*"")),""X"","""")"
Range("JN3:JN" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_NAme_ICG_Ops&""*"")),""X"","""")"
Range("JO3:JO" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_ICG_Tech&""*"")),""X"","""")"
Range("JP3:JP" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_Business&""*"")),""X"","""")"
Range("JQ3:JQ" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_LF_PBWM_Ops&""*"")),""X"","""")"
Range("JR3:JR" & lrow).Formula2R1C1 = "=IF(OR(COUNTIF(RC279,""*""&MS_ID_Name_LF_PBWM_Tech&""*"")),""X"","""")"
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
'Copy Formula and Paste Special Values - Remove Formula
Range("HN3:ID3" & lrow).Copy
Range("HN3:ID3" & lrow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("JB3:JR3" & lrow).Copy
Range("JB3:JR3" & lrow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("KP1").Select
MsgBox ("Macro is Finished")
End Sub
Thank you,