VBA Taking Long Time to Run

MHamid

Active Member
Joined
Jan 31, 2013
Messages
472
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

Can anyone assist with making the below code more efficient? It seems to be taking roughly 10-15 minutes to complete.

VBA Code:
Sub HierarchyFlag()
'
' HierarchyFlag Macro
'
'Disbale Excel properties while macrro runs
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

'Define Variables
Dim lRow As Long
lRow = Range("S" & Rows.Count).End(xlUp).Row

'Formula to Flag Managed Segment (Home) - NodeNumber
    Range("A3:A" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C17:R304C17,Mapping!RC18))))>0,""X"","""")"
    Range("B3:B" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C23:R39C23,Mapping!RC18))))>0,""X"","""")"
    Range("C3:C" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C14:R99C14,Mapping!RC18))))>0,""X"","""")"
    Range("D3:D" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C11:R55C11,Mapping!RC18))))>0,""X"","""")"
    Range("E3:E" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C8:R53C8,Mapping!RC18))))>0,""X"","""")"
    Range("F3:F" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C20:R274C20,Mapping!RC18))))>0,""X"","""")"
    Range("G3:G" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C44:R6C44,Mapping!RC18))))>0,""X"","""")"
    Range("H3:H" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C32:R80C32,Mapping!RC18))))>0,""X"","""")"
    Range("I3:I" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C47:R8C47,Mapping!RC18))))>0,""X"","""")"
    Range("J3:J" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C5:R8C5,Mapping!RC18))))>0,""X"","""")"
    Range("K3:K" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C26:R213C26,Mapping!RC18))))>0,""X"","""")"
    Range("L3:L" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C29:R96C29,Mapping!RC18))))>0,""X"","""")"
    Range("M3:M" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C35:R283C35,Mapping!RC18))))>0,""X"","""")"
    Range("N3:N" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C38:R322C38,Mapping!RC18))))>0,""X"","""")"
    Range("O3:O" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C41:R3577C41,Mapping!RC18))))>0,""X"","""")"
    Range("P3:P" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C50:R72C50,Mapping!RC18))))>0,""X"","""")"
    Range("Q3:Q" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C53:R53C53,Mapping!RC18))))>0,""X"","""")"
    
'Formula to Flag Managed Segment (Impacted)-Node Number
    Range("U3:U" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C17:R304C17,Mapping!RC38))))>0,""X"","""")"
    Range("V3:V" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C23:R39C23,Mapping!RC38))))>0,""X"","""")"
    Range("W3:W" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C14:R99C14,Mapping!RC38))))>0,""X"","""")"
    Range("X3:X" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C11:R55C11,Mapping!RC38))))>0,""X"","""")"
    Range("Y3:Y" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C8:R53C8,Mapping!RC38))))>0,""X"","""")"
    Range("Z3:Z" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C20:R274C20,Mapping!RC38))))>0,""X"","""")"
    Range("AA3:AA" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C44:R6C44,Mapping!RC38))))>0,""X"","""")"
    Range("AB3:AB" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C32:R80C32,Mapping!RC38))))>0,""X"","""")"
    Range("AC3:AC" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C47:R8C47,Mapping!RC38))))>0,""X"","""")"
    Range("AD3:AD" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C5:R8C5,Mapping!RC38))))>0,""X"","""")"
    Range("AE3:AE" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C26:R213C26,Mapping!RC38))))>0,""X"","""")"
    Range("AF3:AF" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C29:R96C29,Mapping!RC38))))>0,""X"","""")"
    Range("AG3:AG" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C35:R283C35,Mapping!RC38))))>0,""X"","""")"
    Range("AH3:AH" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C38:R322C38,Mapping!RC38))))>0,""X"","""")"
    Range("AI3:AI" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C41:R3577C41,Mapping!RC38))))>0,""X"","""")"
    Range("AJ3:AJ" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C50:R72C50,Mapping!RC38))))>0,""X"","""")"
    Range("AK3:AK" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT List'!R2C53:R53C53,Mapping!RC38))))>0,""X"","""")"

'Formula to Flag Accountable Executive
    Range("AO3:AO" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C29:R14581C29,Mapping!RC58))))>0,""X"","""")"
    Range("AP3:AP" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C41:R1048C41,Mapping!RC58))))>0,""X"","""")"
    Range("AQ3:AQ" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C23:R7437C23,Mapping!RC58))))>0,""X"","""")"
    Range("AR3:AR" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C11:R3791C11,Mapping!RC58))))>0,""X"","""")"
    Range("AS3:AS" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C17:R2043C17,Mapping!RC58))))>0,""X"","""")"
    Range("AT3:AT" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C35:R10201C35,Mapping!RC58))))>0,""X"","""")"
    Range("AU3:AU" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C83:R4C83,Mapping!RC58))))>0,""X"","""")"
    Range("AV3:AV" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C47:R16685C47,Mapping!RC58))))>0,""X"","""")"
    Range("AW3:AW" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C89:R84C89,Mapping!RC58))))>0,""X"","""")"
    Range("AX3:AX" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C5:R356C5,Mapping!RC58))))>0,""X"","""")"
    Range("AY3:AY" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C95:R37613C95,Mapping!RC58))))>0,""X"","""")"
    Range("AZ3:AZ" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C101:R17696C101,Mapping!RC58))))>0,""X"","""")"
    Range("BA3:BA" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C53:R32501C53,Mapping!RC58))))>0,""X"","""")"
    Range("BB3:BB" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C59:R35048C59,Mapping!RC58))))>0,""X"","""")"
    Range("BC3:BC" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C65:R18446C65,Mapping!RC58))))>0,""X"","""")"
    Range("BD3:BD" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C71:R14175C71,Mapping!RC58))))>0,""X"","""")"
    Range("BE3:BE" & lRow).Formula = "=IF(SUMPRODUCT(--(ISNUMBER(SEARCH('DSMT-SOEID List'!R3C77:R155506C77,Mapping!RC58))))>0,""X"","""")"
    
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
    
'Copy Formula and Paste Special Values - Remove Formula
    Range("A3:BE3" & lRow).Copy
    Range("A3:P3" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    

End Sub

Thank you,
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Since your final result is to put an X or a blank into a cell depending on whether the search function foudn a string this would be much much faster if you loaded the entire sheet into a variant array then did the search for the string in using the vba INST function, write the results to anotehr variant array and finally write the resuls to the worksheet , it should take seconds. I haven't got time to do this for you at the moment. sorry
 
Upvote 0
You can comment on the following:
- Name of the sheet where the formula goes.
- Number of records on that sheet.
- Examples of what you have in this range in the DSMT List sheet.
Dante Amor
AEHKNQTWZACAFAIALAOARAUAXBA
2
3
DSMT List


- Examples of what you have in these cells in the Mapping sheet:
Dante Amor
RALBF
3
4
Mapping


Note:
Use XL2BB tool minisheet to give the examples.
 
Upvote 0
You can comment on the following:
- Name of the sheet where the formula goes.
- Number of records on that sheet.
- Examples of what you have in this range in the DSMT List sheet.
Dante Amor
AEHKNQTWZACAFAIALAOARAUAXBA
2
3
DSMT List


- Examples of what you have in these cells in the Mapping sheet:
Dante Amor
RALBF
3
4
Mapping


Note:
Use XL2BB tool minisheet to give the examples.
Hi Dante,

Apologies for the delay in my response.

- Name of the sheet where the formula goes. - Mapping; columns A3:Q ... columns U3:AK ... Columns AO3:BE
- Number of records on that sheet. - Varies; dependent on the count in column S
- Examples of what you have in this range in the DSMT List sheet. - I cannot use XL2BB on my work session. Please copy the below into the DSMT List starting in column E.
MS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness NameMS Level IDBusiness Name
(9900592)Business Simplification(27318)COO(20486)CISO(8163)CSS(27825)CTI(16312)EIO&T Change Management(6804)CAO(26042)PBWM Operations(22823)PBWM Technology(27317)GFT(22939)ICG Operations(22941)ICG Technology(4463)Non O&T Business(6647)O&T Other(28016)Operational Effectiveness(29034)LF - PBWM Operations(29032)LF - PBWM Technology
(27795)Business Simplification(9906808)COO(9923956)CISO(9920488)CSS(6719)CTI(20483)EIO&T Change Management(20485)CAO(22626)PBWM Operations(9900462)PBWM Technology(28606)GFT(4349)ICG Operations(9905510)ICG Technology(24739)Non O&T Business(9921842)O&T Other(9914268)Operational Effectiveness(9900753)LF - PBWM Operations(9900743)LF - PBWM Technology
(28082)Business Simplification(17786)COO(9900602)CISO(9906642)CSS(14772)CTI(9922130)EIO&T Change Management(9900630)CAO(14251)PBWM Operations(9905979)PBWM Technology(9900611)GFT(24908)ICG Operations(9900284)ICG Technology(28614)Non O&T Business(6667)O&T Other(14269)Operational Effectiveness(9900751)LF - PBWM Operations(9900740)LF - PBWM Technology
(28083)Business Simplification(9916865)COO(9900827)CISO(9908165)CSS(27826)CTI(7036)EIO&T Change Management(9923623)CAO(25811)PBWM Operations(9900465)PBWM Technology(9900604)GFT(4320)ICG Operations(27281)ICG Technology(16803)Non O&T Business(6677)O&T Other(28018)Operational Effectiveness(9900750)LF - PBWM Operations(9900739)LF - PBWM Technology
(28085)Business Simplification(9900631)COO(9900343)CISO(9908260)CSS(16387)CTI(9918243)EIO&T Change Management(9900341)CAO(9900030)PBWM Operations(9900466)PBWM Technology(9906753)GFT(27315)ICG Operations(26202)ICG Technology(5216)Non O&T Business(6678)O&T Other(24706)Operational Effectiveness(29039)LF - PBWM Operations(9900741)LF - PBWM Technology

- Examples of what you have in these cells in the Mapping sheet: - Same as above example. Copy data below into cell A1:BF
EO&TPBWMICGBusinessLF
EO&TPBWMICGBusinessLFEO&TPBWMICGLFBusiness18 OUT OF 37 DO NOT HAVE SOEID
CTICAOCSSCISOCOOEIO&T Change ManagementO&T OtherGFTOperational ExcellenceBusiness SimplificationPBWM OperationsPBWM TechnologyICG OperationsICG TechnologyNon-O&T BusinessLF - PBWM OperationsLF - PBWM - TechnologyManaged Segment (Home)- NodeNumberAudit NumberCTICAOCSSCISOCOOEIO&T Change ManagementO&T OtherGFTOperational ExcellenceBusiness SimplificationPBWM OperationsPBWM TechnologyICG OperationsICG TechnologyNon-O&T BusinessLF - PBWM OperationsLF - PBWM - TechnologyManaged Segment (Impacted)-Node NumberCTICAOCSSCISOCOOEIO&T Change ManagementO&T OtherGFTOperational ExcellenceBusiness SimplificationPBWM OperationsPBWM TechnologyICG OperationsICG TechnologyLF - PBWM OperationsLF - PBWM TechnologyNon-O&T BusinessAccountable Executive
Reporting Operations [L7](23817) - 23817|FRSS Management [L7](27803) - 27803|Capital Planning [L7](27816) - 27816A470410Nitta,Kenichiro (KN17516)
ICRM-ICG Markets & Securities Services [L8](23427) - 23427|ICRM - Global Management [L6](9914523) - 9914523A521178Independent Compliance Risk Management [L5](5159) - 5159|Independent Compliance Risk Management [L5](5159) - 5159|Independent Compliance Risk Management [L5](5159) - 5159|Independent Compliance Risk Management [L5](5159) - 5159|Independent Compliance Risk Management [L5](5159) - 5159Linnett,James (JL99778)|Riley,Stuart (SR44185)|Adams,James (JA54828)|Zafar,Shadman (SZ82084)
Global Consumer Business Operational Risk & Control [L7](9921513) - 9921513|ICRM-Prudential Testing [L7](24749) - 24749|Risk Retail Bank & Mortgage [L9](27478) - 27478|Employee Fulfillment [L13](24753) - 24753|MSS Risk & Control [L9](978) - 978|Business Controls & Risk [L8](20278) - 20278|Retail/Holdings Tech Global [L9](25337) - 25337|North America Consumer Bank Operations [L8](9900030) - 9900030|Core Operations [L9](28363) - 28363|ICRM PBWM Cards [L7](5181) - 5181|Wealth [L7](9914490) - 9914490|ICRM-Bank Regulatory [L8](27440) - 27440A404991Other Citi Markets Management [L6](24122) - 24122|PB Business [L7](24656) - 24656|Wealth [L7](9914490) - 9914490|Macys [L7](8848) - 8848|Citi Retail Services [L6](9908839) - 9908839|Co-Branded Cards [L7](24587) - 24587|Consumer Mortgages [L6](25371) - 25371|Retail Banking excl. Mortgages & Unsecured [L6](4587) - 4587Chung,Claire (CC32547)|Kane,Declan (DK29910)


Hope that helps.
 
Upvote 0
- Number of records on that sheet. - Varies; dependent on the count in column S
What is the approximate number of records that the macro takes a long time with?

Are all MS Level IDs unique in the entire DSMT List sheet?
 
Upvote 0
There are approximately 900 records.
Yes, theLevel IDs are unique
 
Upvote 0
I didn't do many tests, but with 1000 records the result is immediate. Try, check the results and tell me.

VBA Code:
Sub HierarchyFlag()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim dic As Object, dic2 As Object, dicar1 As Object, dicar3 As Object
  Dim i As Long, j As Long
  Dim lr1 As Long, lr2 As Long, lr3 As Long, cola As Long, colb As Long
  Dim a As Variant, c As Variant
  Dim b1 As Variant, b2 As Variant, b3 As Variant, b4 As Variant, b5 As Variant, b6 As Variant
  Dim ar1 As Variant, ar3 As Variant
  Dim lv As String, lv2 As Variant
  
  Set sh1 = Sheets("Mapping")
  Set sh2 = Sheets("DSMT List")
  Set sh3 = Sheets("DSMT-SOEID List")
  Set dic = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  Set dicar1 = CreateObject("Scripting.Dictionary")
  Set dicar3 = CreateObject("Scripting.Dictionary")
  
  'data Mapping
  lr1 = sh1.Range("S" & Rows.Count).End(xlUp).Row
  b1 = sh1.Range("R3:R" & lr1).Value
  b3 = sh1.Range("AL3:AL" & lr1).Value
  b5 = sh1.Range("BF3:BF" & lr1).Value
  
  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
  
  ar1 = Array("", "Q", "W", "N", "K", "H", "T", "AR", "AF", "AU", "E", "Z", "AC", "AI", "AL", "AO", "AX", "BA")
  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("", "AC", "AO", "W", "K", "Q", "AI", "CE", "AU", "CK", "E", "CQ", "CW", "BA", "BG", "BM", "BS", "BY")
  For i = 1 To UBound(ar3)
    'stores position 1, 2, 3... and its respective search column
    dicar3(Columns(ar3(i)).Column) = i
  Next
    
  'data DSMT List
  lr2 = sh2.Cells.Find("*", , xlValues, xlPart, , xlPrevious).Row
  a = sh2.Range("E2", sh2.Range("BA" & lr2)).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 + 4      'more 4 because start in column E
    Next
  Next
  
  'check column "R"
  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 "AL"
  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 start column U
        b4(i, colb) = "X"
      End If
    Next
  Next
  
  'data DSMT-SOEID List
  lr3 = sh3.Cells.Find("*", , xlValues, xlPart, , xlPrevious).Row
  c = sh3.Range("E2", sh3.Range("CW" & lr2)).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 + 4      'more 4 because start in column E
    Next
  Next

  'check column "BF"
  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("A3").Resize(UBound(b2, 1), UBound(b2, 2)).Value = b2
  sh1.Range("U3").Resize(UBound(b4, 1), UBound(b4, 2)).Value = b4
  sh1.Range("AO3").Resize(UBound(b6, 1), UBound(b6, 2)).Value = b6
End Sub
 
Upvote 0
Solution
I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,215,734
Messages
6,126,544
Members
449,316
Latest member
sravya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top