procedure too large with 600 lines

Question

I'm trying to generate code with 600 lines and it gives me an error about size "procedure too large".

I would appreciate help on how to split the code so that it works properly?

       Private Sub Worksheet_SelectionChange(ByVal Target As Range)
               Me.Range("C1").Interior.Color = Me.Range("A1").Interior.Color
               Me.Range("C2").Interior.Color = Me.Range("A2").Interior.Color
               Me.Range("C3").Interior.Color = Me.Range("A3").Interior.Color
               Me.Range("C4").Interior.Color = Me.Range("A4").Interior.Color
               Me.Range("C5").Interior.Color = Me.Range("A5").Interior.Color
               Me.Range("C6").Interior.Color = Me.Range("A6").Interior.Color
               Me.Range("C7").Interior.Color = Me.Range("A7").Interior.Color
               Me.Range("C8").Interior.Color = Me.Range("A8").Interior.Color
               Me.Range("C9").Interior.Color = Me.Range("A9").Interior.Color
               Me.Range("C10").Interior.Color = Me.Range("A10").Interior.Color
               Me.Range("C11").Interior.Color = Me.Range("A11").Interior.Color
               Me.Range("C12").Interior.Color = Me.Range("A12").Interior.Color

               ...
       End Sub

[Procedure too large](https://stackoverflow.com/questions/3751263/procedure-too-large) ? — T.M., Mar 06 '23 at 07:09

VBasic2008 · Answer 1 · 2023-03-06T07:50:59.577

Copy Cell Colors to Another Column

From an event code, you could call it with the simple
```
CopyColors Me
```
where Me is a reference to the worksheet behind the code.

You need to think about how to use it. It makes no sense to use it on each selection. Maybe restrict it to a single cell e.g. B1:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 0 Then Exit Sub
    If Intersect(Target, Me.Range("B1")) Is Nothing Then Exit Sub
    ' Now call it:
    CopyColors Me
End If

The Code

Sub CopyColors(ByVal ws As Worksheet)
    
    Const SRC_RANGE As String = "A1:A600"
    Const DST_COLUMN As String = "C"
    
    Dim srg As Range: Set srg = ws.Range(SRC_RANGE)
    Dim cOffset As Long: cOffset = ws.Columns(DST_COLUMN).Column - srg.Column
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim sCell As Range, sColor As Long
    
    For Each sCell In srg.Cells
        sColor = sCell.Interior.Color
        If dict.Exists(sColor) Then
            Set dict(sColor) = Union(dict(sColor), sCell)
        Else
            Set dict(sColor) = sCell
        End If
    Next sCell
    
    Dim Key
    
    For Each Key In dict.Keys
        dict(Key).Offset(, cOffset).Interior.Color = Key
    Next Key

End Sub

I am trying to generate a dynamic map with 600 cells. So that any change in color that I define in the database table, I will also see the color on the map I built - associating cells with color — צוריאל כץ, Mar 06 '23 at 08:13
Yes, I tried it, it's just too long. Is it possible to split the order Sub CopyColors(ByVal ws As Worksheet) into 2 or 3? Sub CopyColors(ByVal ws As Worksheet)_1-------- Sub CopyColors(ByVal ws As Worksheet)_2------------ Sub CopyColors(ByVal ws As Worksheet)_3 — צוריאל כץ, Mar 06 '23 at 09:10
Sorry, but what does *"it's just too long"*? This code is supposed to be a replacement for your 600 lines. So is the code in ΑΓΡΙΑ ΠΕΣΤΡΟΦΑ's answer. — VBasic2008, Mar 06 '23 at 16:02

ΑΓΡΙΑ ΠΕΣΤΡΟΦΑ · Answer 2 · 2023-03-06T09:38:35.143

I dont't know what you want to do... but this code is not related to the "target" and could be a separate "sub" called by the event

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim c As Long, rowYouWant As Long, r As Range
    rowYouWant = 20
    Application.ScreenUpdating = False
    Set r = Range("A1") 'starting cell
    With r
        For c = 0 To rowYouWant
            .Offset(c, 2).Interior.Color = .Offset(c, 0).Interior.Color
        Next
    End With
End Sub

'---------------------------------------------------------

Option Explicit

Const SOURSE_RANGE = "C1:C600"
Const FIRST_CELL_OF_MAP = "A1"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sourseRange As String
    If Not Intersect(Target, Range(SOURSE_RANGE)) Is Nothing Then
        Call copyIntColor
    End If
End Sub

Private Sub copyIntColor()
    Dim cr As Long, cc As Long, colCnt As Long, rowCnt As Long, r As Range, sr As Range
    
    Set sr = Range(SOURSE_RANGE) 'range of table
    colCnt = sr.Columns.CountLarge - 1
    rowCnt = sr.Rows.CountLarge - 1
    Set sr = sr.Cells(1, 1)
    Set r = Range(FIRST_CELL_OF_MAP) 'starting cell of map
    Application.ScreenUpdating = False
    With r
        For cr = 0 To rowCnt
            For cc = 0 To colCnt
                r.Offset(cr, cc).Interior.Color = sr.Offset(cr, cc).Interior.Color
            Next
        Next
    End With
End Sub

I would like to point out that it would be good to run the code on a button click and not on every "Worksheet_SelectionChange" event

I am trying to generate a dynamic map with 600 cells. So that any change in color that I define in the database table, I will also see the color on the map I built - associating cells with color — צוריאל כץ, Mar 06 '23 at 08:13
ok, whitch is the address (range) of the table and whitch is the address (range) where you want to build your map? The "table" and the "map" will have the same number of rows and columns? if "YES" with a small modification of the code... can do this. — ΑΓΡΙΑ ΠΕΣΤΡΟΦΑ, Mar 06 '23 at 08:22
Yes, they will have the same size - the database with 600 cells, and also the map with 600 cells. What change do you propose to make? — צוריאל כץ, Mar 06 '23 at 09:08
"could be a separate "sub" called by the event". CAN U SHOW ME HOW TO DO IT PLS? — צוריאל כץ, Mar 06 '23 at 10:22

procedure too large with 600 lines

2 Answers2

Copy Cell Colors to Another Column