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