Smaller Procedures in case procedure

[Graham]

I am having difficulty breaking down a large procedure into smaller ones
as the program tells me I have exceeded the 64K and must do this. The
program which puts numbers 1 to 12 in a column based on matching values
in another column, rngA, as shown in part of the procedure below. This
comprises 9 Cases with 12 sub cases in each of these. Now prior to this
stage there was only the chance of 7 values matching in sequence in rngA
so 7 Cases with 12 subcases in each worked perfectly. Now there is the
possiblity of their being 9 matches so I had to add on another 2 Cases
with the 12 sub cases and that is when it went over the top. I
appreciate there must be a far better way of writing something like this
but up to now I am afraid it was "wasn't broken so why fix it" type of
philosphy. My limitations however have now caught me out and I cannot
seem to get this to work in breaking it into calling sub procedures as I
don't think they are linking to the earlier section of the procedure,
basically however I just don't know. I have shown below the start of the
procedure and the firts case scenario as a guide as to what has to be
broken down as it follows the same format to the end of the procedure.
If anyone has had the patience to read this and is able to understand
these ramblings I would appreciate any guidlines if at all possible.

Regrads,
Graham



Sub TrialSort()
Dim Rng As Range
Dim rngA As Range
Dim TotA As Double
Dim TotB As Double
Dim cl As Range
Dim NextRow As Integer
Dim ValueTomatch As String

If IsEmpty(Cells(1, 1)) Then
Rows("1:1").Delete
End If
Set Rng = Range("A13:t400") '<<<<modified
Set rngA = Range("h13:h400") '<<<<modified
Rng.Interior.ColorIndex = xlNone
NextRow = 15
On Error Resume Next
For Each cl In rngA.Cells
If NextRow = cl.Row Then
ValueTomatch = cl.Text
TotA = cl.Offset(0, 1).Value
Select Case WorksheetFunction.CountIf(rngA, ValueTomatch)
Case 1
Select Case cl.Offset(-1, -3).Value
Case 0
cl.Offset(0, -3).Value = 1
Case 1
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 2
Else
cl.Offset(0, -3).Value = 1
End If
Case 2
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 3
Else
cl.Offset(0, -3).Value = 1
End If
Case 3
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 4
Else
cl.Offset(0, -3).Value = 1
End If
Case 4

If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 5
Else
cl.Offset(0, -3).Value = 1
End If
Case 5
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 6
Else
cl.Offset(0, -3).Value = 1
End If
Case 6
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 7
Else
cl.Offset(0, -3).Value = 1
End If
Case 7
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 8
Else
cl.Offset(0, -3).Value = 1
End If
Case 8
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 9
Else
cl.Offset(0, -3).Value = 1
End If
Case 9
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 10
Else
cl.Offset(0, -3).Value = 1
End If
Case 10
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 11
Else
cl.Offset(0, -3).Value = 1
End If
Case 11
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 12
Else
cl.Offset(0, -3).Value = 1
End If
Case 12
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 1
Else
cl.Offset(0, -3).Value = 1
End If
End Select
NextRow = cl.Row + 1


Case 2
Select Case cl.Offset(-1, -3).Value
Case 0
cl.Offset(0, -3).Value = 1
cl.Offset(1, -3).Value = 2
Case 1
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And cl.Offset(-1,
-6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 2
cl.Offset(1, -3).Value = 3
Else
cl.Offset(0, -3).Value = 1
cl.Offset(1, -3).Value = 2
End If
Case 2......etc

 

[Bob Phillips]

Cut out the repetition

Sub TrialSort()
Dim Rng As Range
Dim rngA As Range
Dim TotA As Double
Dim TotB As Double
Dim cl As Range
Dim NextRow As Integer
Dim ValueTomatch As String

If IsEmpty(Cells(1, 1)) Then

Rows("1:1").Delete
End If

Set Rng = Range("A13:t400") '<<<<modified
Set rngA = Range("h13:h400") '<<<<modified
Rng.Interior.ColorIndex = xlNone
NextRow = 15
On Error Resume Next
For Each cl In rngA.Cells

If NextRow = cl.Row Then

ValueTomatch = cl.Text
TotA = cl.Offset(0, 1).Value
Select Case WorksheetFunction.CountIf(rngA, ValueTomatch)
Case 1
Select Case cl.Offset(-1, -3).Value
Case 0: cl.Offset(0, -3).Value = 1
Case 1: Call TestValue(cl, 2, 1)
Case 2: Call TestValue(cl, 3, 1)
Case 3: Call TestValue(cl, 4, 1)
Case 4: Call TestValue(cl, 5, 1)
Case 5: Call TestValue(cl, 6, 1)
Case 6: Call TestValue(cl, 7, 1)
Case 7: Call TestValue(cl, 8, 1)
Case 8: Call TestValue(cl, 9, 1)
Case 9: Call TestValue(cl, 10, 1)
Case 10: Call TestValue(cl, 11, 1)
Case 11: Call TestValue(cl, 12, 1)
Case 12: Call TestValue(cl, 1, 1)
End Select

NextRow = cl.Row + 1


and then later

Private Sub TestValue(cl As Range, var1 As Long, var2 As Long)

If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And _
cl.Offset(-1, -6).Value = cl.Offset(0, -6).Value Then

cl.Offset(0, -3).Value = var1
Else

cl.Offset(0, -3).Value = var2
End If
End Sub

 

[Graham]

Hello Bob,
Many thanks for that, I have not seen it done like this but I am still
unsure how it is written once we are in the multiples e.g for Case 4 as
the part in Case 1 you have

Case 4: Call TestValue(cl, 5, 1)

However when we reach Case 9 the Case 4 part has a breakdown as below I
am unsure how to write this format as you have done above. I appreciate
your time and patience.

Graham
(Below is the Case 4 section in Case 9)
Case 4
If cl.Offset(-1, -5).Value = cl.Offset(0, -5).Value And
cl.Offset(-1, -6).Value = cl.Offset(0, -6).Value Then
cl.Offset(0, -3).Value = 1
cl.Offset(1, -3).Value = 2
cl.Offset(2, -3).Value = 3
cl.Offset(3, -3).Value = 4
cl.Offset(4, -3).Value = 5
cl.Offset(5, -3).Value = 6
cl.Offset(6, -3).Value = 7
cl.Offset(7, -3).Value = 8
cl.Offset(8, -3).Value = 9
Else
cl.Offset(0, -3).Value = 1
cl.Offset(1, -3).Value = 2
cl.Offset(2, -3).Value = 3
cl.Offset(3, -3).Value = 4
cl.Offset(4, -3).Value = 5
cl.Offset(5, -3).Value = 6
cl.Offset(6, -3).Value = 7
cl.Offset(7, -3).Value = 8
cl.Offset(8, -3).Value = 9
End If

 

[Graham]

Sorry, being really really stupid, multiple variables in the call
procedures. Works great.Many thanks for your help.

Graham