Smaller Procedures in case procedure
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
--
HTH
Bob
"Graham" wrote in message
...
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
|