The idea is to assign numbers to three different type of text names that could appear on the worksheet. Those being PACK - ICE - QAPK

The range of columns is a 24 hour period in 15 minute increments.

In the arrays certain number values are associated with the tex values mentioned above.

What ends up happening is let's say were are referring to PACK, it will assign the first value (PK100) and move over column by column until the criteria is no longer met. Then it goes to the nexr row and continues on.

If PK100 could be used again because it has not nbenn used in the current column, it should. My code goes to the next number i.e. PK101, PK102 etc.

Make sense?

This is one of 3 Subs I use

Sub Assign1()

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

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

If InStr("119-133-135-137-139", Trim(Str(j))) Then GoTo skip

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

End Sub