Sub too large

[Guest]

Is there a limit to the size of sub procedure? I am receiving an error for
my procedure being too large.

I need to have cells, call them K1-3 and T1-3, change depeding on what cell
is currently selected. I have a square of cells 31 x 72 for a total of 1,147
possibilities. I have only completed the third column and have already
recieved the error. My code works for two columns but no more. Here is a
sample of what I am doing, please let me know if there is more a way around
this or a different way of performing this function.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'1st of the Month

'Room 1 on the 1st
If Target.Address = ("$B$8") Then Range("K1").Value =
Worksheets("Detail").Range("B4").Value
If Target.Address = ("$B$8") Then Range("K2").Value =
Worksheets("Detail").Range("B5").Value
If Target.Address = ("$B$8") Then Range("K3").Value =
Worksheets("Detail").Range("B6").Value
If Target.Address = ("$B$8") Then Range("T1").Value =
Worksheets("Detail").Range("B7").Value
If Target.Address = ("$B$8") Then Range("T2").Value =
Worksheets("Detail").Range("B8").Value
If Target.Address = ("$B$8") Then Range("T3").Value =
Worksheets("Detail").Range("B9").Value

'Room 2 on the 1st
If Target.Address = ("$B$9") Then Range("K1").Value =
Worksheets("Detail").Range("B13").Value
If Target.Address = ("$B$9") Then Range("K2").Value =
Worksheets("Detail").Range("B14").Value
If Target.Address = ("$B$9") Then Range("K3").Value =
Worksheets("Detail").Range("B15").Value
If Target.Address = ("$B$9") Then Range("T1").Value =
Worksheets("Detail").Range("B16").Value
If Target.Address = ("$B$9") Then Range("T2").Value =
Worksheets("Detail").Range("B17").Value
If Target.Address = ("$B$9") Then Range("T3").Value =
Worksheets("Detail").Range("B18").Value

Joe

 

[Tim Williams]

Look at the selected cell and figure out where it is, then use that
information to determine where the values of your 6 cells can be
found.

dim r as long, c as long
dim a as long, b as long
dim shtSrc as worksheet

set shtSrc = thisworkbook.Worksheets("Detail")

r = Target.Row
c = Target.Column

'use r and c to calculate a and b

with me
.range("K1").value = shtSrc.cells(a,b).value
.range("K2").value = shtSrc.cells(a+1,b).value
.range("K3").value = shtSrc.cells(a+2,b).value
.range("T1").value = shtSrc.cells(a+3,b).value
.range("T2").value = shtSrc.cells(a+4,b).value
.range("T3").value = shtSrc.cells(a+5,b).value
end with


voila!

Tim.

 

[Guest]

Thank you very much. This really helped out.

Look at the selected cell and figure out where it is, then use that
information to determine where the values of your 6 cells can be
found.

dim r as long, c as long
dim a as long, b as long
dim shtSrc as worksheet

set shtSrc = thisworkbook.Worksheets("Detail")

r = Target.Row
c = Target.Column

'use r and c to calculate a and b

with me
.range("K1").value = shtSrc.cells(a,b).value
.range("K2").value = shtSrc.cells(a+1,b).value
.range("K3").value = shtSrc.cells(a+2,b).value
.range("T1").value = shtSrc.cells(a+3,b).value
.range("T2").value = shtSrc.cells(a+4,b).value
.range("T3").value = shtSrc.cells(a+5,b).value
end with


voila!

Tim.

 

[Guest]

The appended code assumes that the data you are extracting from sheet
"Detail" continues in the same pattern in column B (groups of 6 with 3 cell
gaps in between). The code is constructed to handle a total of 6 groups which
are transfered by clicking on cells B8:B13. This demonstrates a technique
only and will require restructuring to suit your particular situation.

Regards,
Greg

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer, ii As Integer, x As Integer
Dim rng As Range

Set rng = Range("B8:B13")
If Target.Count > 1 Or _
Intersect(Target, rng) Is Nothing Then Exit Sub
x = 4
With Worksheets("Sheet2")
For i = 0 To 1
For ii = 1 To 3
Cells(ii, 11 + i * 9) = _
.Cells(x + (Target.Row - 8) * 9, 2)
x = x + 1
Next
Next
End With
End Sub

 

[Guest]

Worksheets("Sheet2") should be Worksheets("Detail").
Sorry, forgot to change it.

Regards,
Greg