| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Smaller Procedures in case procedure
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smaller Procedures in case procedure
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 On 02/04/2010 19:46, Bob Phillips wrote: 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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smaller Procedures in case procedure
Sorry, being really really stupid, multiple variables in the call
procedures. Works great.Many thanks for your help. Graham On 02/04/2010 20:27, Graham wrote: 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 On 02/04/2010 19:46, Bob Phillips wrote: 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| my VBA procedures stopped calling other procedures in excel 2007. | Excel Programming | |||
| Select Case "Procedure to large" Error | Excel Programming | |||
| Simplifying numerous checkbox procedures into 1 procedure | Excel Worksheet Functions | |||
| two procedures in the same sheet one a workbook even procedure | Excel Programming | |||
![Graham[_2_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
