VBA Loop Through List of Named Ranges and Paste Formulas into a Different List of Named Ranges

Jake Peralta

New Member
Joined
Jun 9, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Hi all,

Sorry for the lengthy original post.. I've been looking through the named range loop threads here and elsewhere but haven't been able to find what I'm after. I'm working on a large project which is principally driven by a worksheet change event, whereby each event triggers a copy and paste of formulas from various named ranges to various other named ranges (one by one at present i.e. Range("Copy59").Copy Range("DATA59").PasteSpecial xlPasteFormulas). As of this morning I was only dealing with 60ish named ranges (which was still kind of slow, maybe 30sec or so to complete the change event), but the scope of the project has blown out massively today and I'm now being asked to deal with over 1,600 named ranges (yes, 1,600, i didn't sausage finger an extra zero onto 160 by accident!) and given there's 3 variations on the event change it works out to be over 10,000 lines of code with how I've got it written at the moment and I'm getting a "Procedure is too large" error (exporting the cls file comes in at 110kb and I've read 64kb is the max). When I reduce it to 600 named ranges as a test I get it down to 48kb but it still takes over 5min for the change event to complete which is unacceptable.

Is there any way I can list all the names of the named ranges for where the formulas will be copied from in one column, and all the names of the corresponding destination named ranges in the adjacent column (perhaps it is useful to give each of these lists a named range of their own?) and then produce some code that copies all of the data at once rather than having thousands of lines of code that brings things grinding to a halt? e.g. I'd have a column with all the ranges to be copied that would look like Copy59 Copy60 Copy61 (say we give this a named range of its own "AllMySourceNamedRanges") and then a column with DATA59 DATA60 DATA61 which we can give a named range as well called "AllMyDestinationNamedRanges". From there, ideally what I'm after is Range("AllMySourceNamedRanges").Copy Range("AllMyDestinationNamedRanges").PasteSpecial xlPasteFormulas such that they're all copied and pasted in one go rather than having a copy and a paste line of code for each named range across all three change event scenarios!

Just to clarify, whilst I can put the names of the source and destination named ranges into columns side by side (or even the source named ranges themselves with the formulas), the actual destination cells where the formulas will be copied to can't be all in a single row or column, as they're placed in a logical way on the worksheet for users to make selections. In addition, I also want to try to keep everything on one page so I'm trying to avoid splitting things up over different sheets and/or having to create multiple procedures. Any help would be greatly appreciated folks!
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Imo THE solution does not exist. Several aspects need to be addressed in order to arrive at a workable solution. Just some thoughts:
1. You could split code into different procedures to get around the module memory limit problem. Three change event scenarios could lead to three separate procedures, to be called from the actual Worksheet_Change event procedure; make them public and put them in a standard module.
2. If absolute cell references are used on the worksheets, then any two lines of code such as...
VBA Code:
Range("A1").Copy
Range("Z80").PasteSpecial xlPasteFormulas
may be replaced by one line of code
VBA Code:
Range("Z80").Formula = Range("A1").Formula
thus reducing the amount of code lines.
3. If there is some consistency in the naming of the ranges (source vs target), data could perhaps be copied using a For / Next loop, also reducing the amount of code lines.
4. Your suggestion to work with two columns with the names of source range and target range side by side on the same row (each in their own column of course) is also an option, but even then the use of a For / Next loop will be necessary.
5. Finally, it should be clear that a Change event procedure can be recursive depending on the code used and can lead to the triggering of other events, such as the Calculate event.
It is therefore advisable to take a closer look here to improve performance where possible.
 

Jake Peralta

New Member
Joined
Jun 9, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Imo THE solution does not exist. Several aspects need to be addressed in order to arrive at a workable solution. Just some thoughts:
1. You could split code into different procedures to get around the module memory limit problem. Three change event scenarios could lead to three separate procedures, to be called from the actual Worksheet_Change event procedure; make them public and put them in a standard module.
2. If absolute cell references are used on the worksheets, then any two lines of code such as...
VBA Code:
Range("A1").Copy
Range("Z80").PasteSpecial xlPasteFormulas
may be replaced by one line of code
VBA Code:
Range("Z80").Formula = Range("A1").Formula
thus reducing the amount of code lines.
3. If there is some consistency in the naming of the ranges (source vs target), data could perhaps be copied using a For / Next loop, also reducing the amount of code lines.
4. Your suggestion to work with two columns with the names of source range and target range side by side on the same row (each in their own column of course) is also an option, but even then the use of a For / Next loop will be necessary.
5. Finally, it should be clear that a Change event procedure can be recursive depending on the code used and can lead to the triggering of other events, such as the Calculate event.
It is therefore advisable to take a closer look here to improve performance where possible.
Thanks GWteB. I've implemented bullet points 1 and 2 for now and this has helped to a degree in that it circumvents the memory issue. That said, even doing a test where I reduced the number of named ranges down to 750, included Application.Calculation = xlCalculationManual and where I removed what I realised were two superfluous variations of the change event (they were just repeating the same copy paste code with some minor differences around the fringes which I can live without), this still takes close to 2 minutes to move between the change events (e.g. from New Entry to Update Entry or Clone Entry). This would also require having to say to the project stakeholders that they'll need some sort of manual workaround for large customers that would require exceeding that limit which is not ideal.

Hence, I wanted to ask you / anyone else who may know what the For / Next loop would look like given it's a bit different with having a list of all the named ranges and the formulas in the cells of those named ranges, along with an adjacent list of their destination named ranges as opposed to just a cell to cell which I've seen and used before with offsets? Also, is it actually likely to make it faster given loops usually chew up a fair bit of processing power or would all that do is just reduce the size of the procedure such that we circumvent the memory issue in a more 'elegant' way?

Thanks again
 

Jake Peralta

New Member
Joined
Jun 9, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
It might be helpful as well if I actually paste the code.. What I also didn't realise until about an hour ago when I put a stop and a few breaks in the code to see how it was firing, is that it doesn't actually complete all the Range("DATA1") = Range("Copy1").Formula operations one after the other. i.e. it will do DATA1, then skip to the End If and move through all the stuff towards the bottom such as Call ImportComboBoxes etc, then do the same thing for DATA2 and so on, which is actually what is making it take so long. When I commented out that entire section and just ran the Call Ranges1to750 section it reduced the time down from over 1min to under 30sec.. Is there any way to have the section starting at Call ImportComboBoxes only fire one time right at the end rather than for every single one of the 750 named ranges the event goes through? Thanks in advance : )

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("EntrySelection")) Is Nothing Then
If Range("EntrySelection").Value = "Update Entry" Or Range("EntrySelection").Value = "New Entry" Or Range("EntrySelection").Value = "Clone Entry" Then
Unprotect Password:="M!chael"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("EntryNumber").ClearContents

Call Ranges1to750 ' Have used the following convention within this Sub in order to reduce the number of lines: Range("DATA1") = Range("Copy1").Formula

If Range("EntrySelection").Value = "New Entry" Then
Range("EntryNumber").Value = Range("NewEntryLookup").Value
End If
    Protect Password:="M!chael"
   End If
   End If
   
    Call ImportComboBoxes

        Unprotect Password:="M!chael"
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    If Range("F25").Value = "" Or Range("F25").Value = 0 Then
            Range("F25").Locked = False
    Else: Range("F25").Locked = True
    End If

    If Range("DATA1").Value = "Retail" Or Range("DATA1").Value = "Retail Collections" Or Range("DATA1").Value = "" Or Range("DATA1").Value = 0 Then
        Rows("12:14").EntireRow.Hidden = True
        Rows("24:35").EntireRow.Hidden = True
        Rows("39:41").EntireRow.Hidden = True
        Rows("63:126").EntireRow.Hidden = True

    ElseIf Range("DATA1").Value <> "Retail" And Range("DATA1").Value <> "Retail Collections" And Range("DATA1").Value <> "" And Range("DATA1").Value <> 0 Then
        Rows("12:14").EntireRow.Hidden = False
        Rows("24:35").EntireRow.Hidden = False
        Rows("39:41").EntireRow.Hidden = False
        Rows("63:65").EntireRow.Hidden = False
    End If

    If Range("DATA27").Value = "No" Or Range("DATA27").Value = "" Or Range("DATA27").Value = 0 Then
        Rows("45:47").EntireRow.Hidden = True
    ElseIf Range("DATA27").Value <> "No" Then
        Rows("45:47").EntireRow.Hidden = False
    End If

    If Range("CountCell").Value < 1 Or Range("CountCell").Value = "" Or Range("CountCell").Value = 0 Or Range("DATA27").Value = "" Or Range("DATA27").Value = 0 Or Range("DATA27").Value = "No" Then
        Rows("48:62").EntireRow.Hidden = True
    ElseIf Range("DATA27").Value <> "No" And Range("CountCell").Value >= 1 Then
        Rows("48:62").EntireRow.Hidden = False
    End If

    If Range("DATA30").Value = "No" Or Range("DATA30").Value = "" Or Range("DATA30").Value = 0 Then
        Rows("66:68").EntireRow.Hidden = True
    ElseIf Range("DATA30").Value <> "No" And Range("DATA1").Value <> "Retail" And Range("DATA1").Value <> "Retail Collections" Then
        Rows("66:68").EntireRow.Hidden = False
    End If

        If Range("CountCell2").Value < 1 Or Range("CountCell2").Value = "" Or Range("CountCell2").Value = 0 Or Range("DATA30").Value = "" Or Range("DATA30").Value = 0 Or Range("DATA30").Value = "No" Then
        Rows("69:83").EntireRow.Hidden = True
    ElseIf Range("DATA30").Value <> "No" And Range("CountCell2").Value >= 1 Then
        Rows("69:83").EntireRow.Hidden = False
    End If

    If Range("Question1").Value = "No" Or Range("Question1").Value = "" Or Range("Question1").Value = "Select an option..." Then
        Rows("84:110").EntireRow.Hidden = True
    ElseIf Range("Question1").Value = "Yes" And Range("DATA1").Value <> "Retail" And Range("DATA1").Value <> "Retail Collections" Then
        Rows("84:110").EntireRow.Hidden = False
    End If

    If Range("Question2").Value = "No" Or Range("Question2").Value = "" Or Range("Question2").Value = "Select an option..." Then
        Rows("112:126").EntireRow.Hidden = True
    ElseIf Range("Question2").Value = "Yes" And Range("DATA1").Value <> "Retail" And Range("DATA1").Value <> "Retail Collections" Then
        Rows("112:126").EntireRow.Hidden = False
    End If
    Application.Calculation = xlCalculationAutomatic
End Sub
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Hence, I wanted to ask you / anyone else who may know what the For / Next loop would look like ......

Had two types in mind. If there were some consistent naming of the named ranges, then a loop could look like this:

VBA Code:
Public Sub ExampleOne()

    Dim i As Long
    For i = 1 To 750
        Range("Data" & i).Formula = Range("Copy" & i).Formula
    Next i
End Sub

In case there is no consistent naming and therefore all ranges per pair would be listed in two adjacent worksheet columns, a loop could look like this:

VBA Code:
Public Sub ExampleTwo()

    Dim c As Range
    For Each c In Range("ColumnWithTargetNamedRanges")
        ' names of the source ranges in the right hand side adjacent column
        Range(c.Text).Formula = Range(c.Offset(0, 1).Text).Formula
    Next c
End Sub

Also, is it actually likely to make it faster given loops usually chew up a fair bit of processing power or would all that do is just reduce the size of the procedure such that we circumvent the memory issue in a more 'elegant' way?

It mainly concerns simplifying the code. The difference in time usage between executing code in a loop or in a batch is hardly noticeable. The fact remains, however, that frequently accessing worksheet areas, by reading and / or changing individual cells, is very time-consuming and therefore noticeably slows down the code. As said, whether this is done in a batch or in a loop makes little difference, the delay is due to the repetitive access to the worksheet.

Because I don't know how your worksheets are set up and I also don't know what your code does, it is difficult to give tailor-made advice. I do have some general remarks to limit the frequent access to worksheet ranges. In the code you posted, the second part performs a series of equations in which seven worksheet ranges are read several times. Some comparisons are made multiple times with a total of 45 individual cells being accessed. An equation consisting of multiple equations involving the same worksheet range can be simplified in such a way that this worksheet range is only included once in the equations, eg
VBA Code:
Range("DATA27").Value = "No" Or Range("DATA27").Value = "" Or Range("DATA27").Value = 0
could be changed to
VBA Code:
CBool(InStr("|No||0|", "|" & Range("DATA27").Value & "|"))
This line of code does the following:
- the desired cell is read and the value found is placed between two "unique" delimiters (the pipe symbol | );
- the resulting string is compared against the custom string "|No||0|" in a way whether the resulting string occurs within that custom string (note that the double || represents the empty string);
- the InStr function returns a number specifying the position of the first occurrence of one string within another;
- in case one string does not occur within the other string, a 0 (zero) is returned;
- the result is then converted into a Boolean variable using the CBool function: 0 equals FALSE, any other number equals TRUE.
To suppress case sensitivity this can be extended to:
VBA Code:
CBool(InStr(1, "|No||0|", "|" & Range("DATA27").Value & "|", vbTextCompare))

To limit the number of cell accesses, you also could consider reading each cell once, storing the values in a memory variable and then use those variables in the equations.

I have elaborated the above comments in an adjustment to your code. For the sake of clarity, I would like to emphasize that there will be hardly any difference in performance between your original code and the following. I'm just using it as an example, perhaps useful in code that actually accesses worksheet ranges hundreds of times, as you mentioned in a previous post.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("EntrySelection")) Is Nothing Then
        If Range("EntrySelection").Value = "Update Entry" Or Range("EntrySelection").Value = "New Entry" Or Range("EntrySelection").Value = "Clone Entry" Then
            Unprotect Password:="M!chael"
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Range("EntryNumber").ClearContents

            Call Ranges1to750 ' Have used the following convention within this Sub in order to reduce the number of lines: Range("DATA1") = Range("Copy1").Formula

            If Range("EntrySelection").Value = "New Entry" Then
                Range("EntryNumber").Value = Range("NewEntryLookup").Value
            End If
            Protect Password:="M!chael"
        End If
    End If

    Call ImportComboBoxes

    Unprotect Password:="M!chael"
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    If Range("F25").Value = "" Or Range("F25").Value = 0 Then
        Range("F25").Locked = False
    Else
        Range("F25").Locked = True
    End If
    
    
    ' __________ Adjustments __________

    Dim Data1   As Variant
    Dim Data27  As Variant
    Dim Data30  As Variant
    Dim Quest1  As Variant
    Dim Quest2  As Variant
    Dim Count1  As Long
    Dim Count2  As Long
    
    Dim bNO27   As Boolean
    Dim bNO30   As Boolean
    
    Data1 = Range("DATA1").Value
    Data27 = Range("DATA27").Value
    Data30 = Range("DATA30").Value
    Quest1 = Range("Question1").Value
    Quest2 = Range("Question2").Value
    Count1 = Range("CountCell").Value
    Count2 = Range("CountCell2").Value

    bNO27 = (CBool(InStr(1, "|NO||0|", "|" & Data27 & "|", vbTextCompare)))  ' (Range("DATA27").Value = "" Or Range("DATA27").Value = 0 Or Range("DATA27").Value = "No")
    bNO30 = (CBool(InStr(1, "|NO||0|", "|" & Data30 & "|", vbTextCompare)))

    If (CBool(InStr(1, "|Retail|Retail Collections||0|", "|" & Data1 & "|", vbTextCompare))) Then
        Rows("12:14").EntireRow.Hidden = True
        Rows("24:35").EntireRow.Hidden = True
        Rows("39:41").EntireRow.Hidden = True
        Rows("63:126").EntireRow.Hidden = True
    Else    ' >> SUPERFLUOUS >>     ElseIf Range("DATA1").Value <> "Retail" And Range("DATA1").Value <> "Retail Collections" And Range("DATA1").Value <> "" And Range("DATA1").Value <> 0 Then
        Rows("12:14").EntireRow.Hidden = False
        Rows("24:35").EntireRow.Hidden = False
        Rows("39:41").EntireRow.Hidden = False
        Rows("63:65").EntireRow.Hidden = False
    End If

    If bNO27 Then
        Rows("45:47").EntireRow.Hidden = True
    ElseIf Data27 <> "No" Then
        Rows("45:47").EntireRow.Hidden = False
    End If

    If Count1 < 1 Or Count1 = "" Or Count1 = 0 Or bNO27 Then
        Rows("48:62").EntireRow.Hidden = True
    ElseIf Data27 <> "No" And Count1 >= 1 Then
        Rows("48:62").EntireRow.Hidden = False
    End If

    If bNO30 Then
        Rows("66:68").EntireRow.Hidden = True
    ElseIf Data30 <> "No" And Data1 <> "Retail" And Data1 <> "Retail Collections" Then
        Rows("66:68").EntireRow.Hidden = False
    End If

    If Count2 < 1 Or Count2 = "" Or Count2 = 0 Or bNO30 Then
        Rows("69:83").EntireRow.Hidden = True
    ElseIf Data30 <> "No" And Count2 >= 1 Then
        Rows("69:83").EntireRow.Hidden = False
    End If

    If Quest1 = "No" Or Quest1 = "" Or Quest1 = "Select an option..." Then
        Rows("84:110").EntireRow.Hidden = True
    ElseIf Quest1 = "Yes" And Data1 <> "Retail" And Data1 <> "Retail Collections" Then
        Rows("84:110").EntireRow.Hidden = False
    End If

    If Quest2 = "No" Or Quest2 = "" Or Quest2 = "Select an option..." Then
        Rows("112:126").EntireRow.Hidden = True
    ElseIf Quest2 = "Yes" And Data1 <> "Retail" And Data1 <> "Retail Collections" Then
        Rows("112:126").EntireRow.Hidden = False
    End If

    Application.Calculation = xlCalculationAutomatic
End Sub
 
Solution

Jake Peralta

New Member
Joined
Jun 9, 2020
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Had two types in mind. If there were some consistent naming of the named ranges, then a loop could look like this:

VBA Code:
Public Sub ExampleOne()

    Dim i As Long
    For i = 1 To 750
        Range("Data" & i).Formula = Range("Copy" & i).Formula
    Next i
End Sub

In case there is no consistent naming and therefore all ranges per pair would be listed in two adjacent worksheet columns, a loop could look like this:

VBA Code:
Public Sub ExampleTwo()

    Dim c As Range
    For Each c In Range("ColumnWithTargetNamedRanges")
        ' names of the source ranges in the right hand side adjacent column
        Range(c.Text).Formula = Range(c.Offset(0, 1).Text).Formula
    Next c
End Sub



It mainly concerns simplifying the code. The difference in time usage between executing code in a loop or in a batch is hardly noticeable. The fact remains, however, that frequently accessing worksheet areas, by reading and / or changing individual cells, is very time-consuming and therefore noticeably slows down the code. As said, whether this is done in a batch or in a loop makes little difference, the delay is due to the repetitive access to the worksheet.

Because I don't know how your worksheets are set up and I also don't know what your code does, it is difficult to give tailor-made advice. I do have some general remarks to limit the frequent access to worksheet ranges. In the code you posted, the second part performs a series of equations in which seven worksheet ranges are read several times. Some comparisons are made multiple times with a total of 45 individual cells being accessed. An equation consisting of multiple equations involving the same worksheet range can be simplified in such a way that this worksheet range is only included once in the equations, eg
VBA Code:
Range("DATA27").Value = "No" Or Range("DATA27").Value = "" Or Range("DATA27").Value = 0
could be changed to
VBA Code:
CBool(InStr("|No||0|", "|" & Range("DATA27").Value & "|"))
This line of code does the following:
- the desired cell is read and the value found is placed between two "unique" delimiters (the pipe symbol | );
- the resulting string is compared against the custom string "|No||0|" in a way whether the resulting string occurs within that custom string (note that the double || represents the empty string);
- the InStr function returns a number specifying the position of the first occurrence of one string within another;
- in case one string does not occur within the other string, a 0 (zero) is returned;
- the result is then converted into a Boolean variable using the CBool function: 0 equals FALSE, any other number equals TRUE.
To suppress case sensitivity this can be extended to:
VBA Code:
CBool(InStr(1, "|No||0|", "|" & Range("DATA27").Value & "|", vbTextCompare))

To limit the number of cell accesses, you also could consider reading each cell once, storing the values in a memory variable and then use those variables in the equations.

I have elaborated the above comments in an adjustment to your code. For the sake of clarity, I would like to emphasize that there will be hardly any difference in performance between your original code and the following. I'm just using it as an example, perhaps useful in code that actually accesses worksheet ranges hundreds of times, as you mentioned in a previous post.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("EntrySelection")) Is Nothing Then
        If Range("EntrySelection").Value = "Update Entry" Or Range("EntrySelection").Value = "New Entry" Or Range("EntrySelection").Value = "Clone Entry" Then
            Unprotect Password:="M!chael"
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Range("EntryNumber").ClearContents

            Call Ranges1to750 ' Have used the following convention within this Sub in order to reduce the number of lines: Range("DATA1") = Range("Copy1").Formula

            If Range("EntrySelection").Value = "New Entry" Then
                Range("EntryNumber").Value = Range("NewEntryLookup").Value
            End If
            Protect Password:="M!chael"
        End If
    End If

    Call ImportComboBoxes

    Unprotect Password:="M!chael"
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    If Range("F25").Value = "" Or Range("F25").Value = 0 Then
        Range("F25").Locked = False
    Else
        Range("F25").Locked = True
    End If
   
   
    ' __________ Adjustments __________

    Dim Data1   As Variant
    Dim Data27  As Variant
    Dim Data30  As Variant
    Dim Quest1  As Variant
    Dim Quest2  As Variant
    Dim Count1  As Long
    Dim Count2  As Long
   
    Dim bNO27   As Boolean
    Dim bNO30   As Boolean
   
    Data1 = Range("DATA1").Value
    Data27 = Range("DATA27").Value
    Data30 = Range("DATA30").Value
    Quest1 = Range("Question1").Value
    Quest2 = Range("Question2").Value
    Count1 = Range("CountCell").Value
    Count2 = Range("CountCell2").Value

    bNO27 = (CBool(InStr(1, "|NO||0|", "|" & Data27 & "|", vbTextCompare)))  ' (Range("DATA27").Value = "" Or Range("DATA27").Value = 0 Or Range("DATA27").Value = "No")
    bNO30 = (CBool(InStr(1, "|NO||0|", "|" & Data30 & "|", vbTextCompare)))

    If (CBool(InStr(1, "|Retail|Retail Collections||0|", "|" & Data1 & "|", vbTextCompare))) Then
        Rows("12:14").EntireRow.Hidden = True
        Rows("24:35").EntireRow.Hidden = True
        Rows("39:41").EntireRow.Hidden = True
        Rows("63:126").EntireRow.Hidden = True
    Else    ' >> SUPERFLUOUS >>     ElseIf Range("DATA1").Value <> "Retail" And Range("DATA1").Value <> "Retail Collections" And Range("DATA1").Value <> "" And Range("DATA1").Value <> 0 Then
        Rows("12:14").EntireRow.Hidden = False
        Rows("24:35").EntireRow.Hidden = False
        Rows("39:41").EntireRow.Hidden = False
        Rows("63:65").EntireRow.Hidden = False
    End If

    If bNO27 Then
        Rows("45:47").EntireRow.Hidden = True
    ElseIf Data27 <> "No" Then
        Rows("45:47").EntireRow.Hidden = False
    End If

    If Count1 < 1 Or Count1 = "" Or Count1 = 0 Or bNO27 Then
        Rows("48:62").EntireRow.Hidden = True
    ElseIf Data27 <> "No" And Count1 >= 1 Then
        Rows("48:62").EntireRow.Hidden = False
    End If

    If bNO30 Then
        Rows("66:68").EntireRow.Hidden = True
    ElseIf Data30 <> "No" And Data1 <> "Retail" And Data1 <> "Retail Collections" Then
        Rows("66:68").EntireRow.Hidden = False
    End If

    If Count2 < 1 Or Count2 = "" Or Count2 = 0 Or bNO30 Then
        Rows("69:83").EntireRow.Hidden = True
    ElseIf Data30 <> "No" And Count2 >= 1 Then
        Rows("69:83").EntireRow.Hidden = False
    End If

    If Quest1 = "No" Or Quest1 = "" Or Quest1 = "Select an option..." Then
        Rows("84:110").EntireRow.Hidden = True
    ElseIf Quest1 = "Yes" And Data1 <> "Retail" And Data1 <> "Retail Collections" Then
        Rows("84:110").EntireRow.Hidden = False
    End If

    If Quest2 = "No" Or Quest2 = "" Or Quest2 = "Select an option..." Then
        Rows("112:126").EntireRow.Hidden = True
    ElseIf Quest2 = "Yes" And Data1 <> "Retail" And Data1 <> "Retail Collections" Then
        Rows("112:126").EntireRow.Hidden = False
    End If

    Application.Calculation = xlCalculationAutomatic
End Sub

Thank you again GWteB. I have used the slim line code you provided, although I had to Dim Count1 and Count2 as variables as opposed to Long as I was getting a runtime error and I also have to admit I'm yet to fully wrap my head around how it works. I used a combination of your loop (the one with consistent naming conventions) as well as adding some stuff in to skip a few items, and then thanks to your comment regarding the accessing of sheets being the primary cause of slowing down the code, I realised that the locking of the sheet after each pass was probably chewing up a load of time. To alleviate this issue, I used the loop to identify when it was at the last item and paste "Done" into cell O1, and then changed the final bit of code back on the change event to say that if O1= "Done" then lock the sheet.

Just as an aside - I ended up moving the section with the bulk of the named ranges into another sheet and am only dealing with about 80 on the sheet above now. In total I've basically halved the time it was taking before and it now only takes about 30sec for the change event to occur (that's comparing like for like i.e. 80 ranges to 80 ranges not 80 ranges to 750). I'm still not thrilled about 30sec but it's a massive win from the position I was in a few days ago, so thank you!

What I might also be able to do is because that section that I've moved onto another sheet is in a nice 100x15 block of cells, I'm hoping I can just set up the formulas in another 100x15 block and just copy and paste formulas for the entire range in one line of code which will be a solution I'm happy with as opposed to looping based on the range name, and if I wanted to I could add this back in to the main sheet at a later date.

I really can't thank you enough for your help on this, I genuinely appreciate it.
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
In reply to your notes ...
... although I had to Dim Count1 and Count2 as variables as opposed to Long as I was getting a runtime error
Because of the cell names, I assumed there were (only) numeric values involved. Have not looked at this in depth so a comparison of a numeric value against a non-numeric value will always result in a type mismatch run-time error. Glad you sorted that.

What I might also be able to do is because that section that I've moved onto another sheet is in a nice 100x15 block of cells, I'm hoping I can just set up the formulas in another 100x15 block and just copy and paste formulas for the entire range in one line of code ...
A solution like this will certainly improve the performance of your code.

I really can't thank you enough for your help on this, I genuinely appreciate it.
You are welcome :) and thanks for letting me know (y)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,393
Messages
5,601,403
Members
414,449
Latest member
Pashtun

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
Top