NEED TO RE-USE NUMBERS FROM ARRAY SO ALL ARE USED

[jmersing]

This is the code I'm using it is used across a range of 96 columns There are 3 other modules that run the same code in different columns. If you look at the illustration I have posted you can see my problem. I want use all of the numerical values as I move through the rows.

Example: H1 ends at 100 with my current code 100 would not be used again in the range. It increments as it drops down each row. I want to be able to use every available number by having the code "reset" itself back to 100 and use any available numbers remaining.

Thanks


Dim arr(100 To 152) As String
Dim arr1, num
Dim arr2
Dim rng As Range, cell As Range
Dim i As Long, j As Long
Dim k As Long
arr1 = Array(125, 127, 129, 131, 133)
arr2 = Array(136, 134, 132, 130, 128, 126, 124, 122, 120, 118, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151)
Dim cells As Range
k = 127

With ActiveSheet


For i = 11 To 298 'was 11 TO 100
For Each cell In Rows(i).Columns("G:Z")
Set rng = Nothing
If cell.Value = "QAPK" Then
Set rng = cell
Exit For
End If
Next
If Not rng Is Nothing Then
For j = LBound(arr1) To UBound(arr1)
num = ""
If Len(Trim(arr(arr1(j)))) = 0 Then
num = arr1(j)
arr(num) = "QA"
Exit For
End If
Next

If num = "" Then num = "PK"
For Each cell In Range(rng, .cells(rng.Row, "Z"))
If cell.Value = "QAPK" Then
cell.Value = "QA" & num
End If
Next
End If
Next

For i = 11 To 298 ' WAS 11 TO 100
k = 127
For Each cell In Rows(i).Columns("G:Z")
Set rng = Nothing
If cell.Value = "ICE" Then
Set rng = cell
Exit For
End If
Next
If Not rng Is Nothing Then
For j = LBound(arr2) To UBound(arr2)
num = ""
If Len(Trim(arr(arr2(j)))) = 0 Then
num = arr2(j)
arr(num) = "IC"
Exit For
End If
Next
If num = "" Then num = "PPI"
For Each cell In Range(rng, .cells(rng.Row, "Z"))
If .cells(i, k).Value = "Y" Then
If cell.Value = "ICE" Then
cell.Value = "IC" & num

End If
End If
Next
End If
Next

For i = 11 To 298 'WAS 10 TO 100
For Each cell In Rows(i).Columns("G:Z")
Set rng = Nothing
If cell.Value = "PACK" Then
Set rng = cell
Exit For
End If
Next
If Not rng Is Nothing Then
For j = 100 To 151 Step 1 ' was 100 to 145
If InStr("119-133-135-137-139", Trim(Str(j))) Then GoTo skip 'was ("119-135-137-139",
num = ""

If Len(Trim(arr(j))) = 0 Then
num = j
arr(num) = "PK"
Exit For
End If
skip: Next
If num = "" Then num = "PPI"
For Each cell In Range(rng, .cells(rng.Row, "Z")) If cell.Value = "PACK" Then
cell.Value = "PK" & num
End If
Next
End If
Next
End With

PostStations.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	100	100	100	100	100	100	100	100	<
2	101	101	101	101	101	101	101	101
3	102	102	102	102	102	102	102	102
4	103	103	103	103	103	103	103	103
5					104	104	104	104	104	104	104	104
6					105	105	105	105	105	105	105	105
7					106	106	106	106	106	106	106	106	<
8								>	100	100	100	100	100	100	100	100
9									101	101	101	101	101	101	101	101
10									102	102	102	102	102	102	102	102
11									103	103	103	103	103	103	103	103
12										>	107	107	107	107	107	107	107	107
13											108	108	108	108	108	108	108	108
Sheet1