Loop not Looping!

[Gavin Harrison]

Hi All.

Can anyone see anything obvious why the loop part of this code if not looping. Its doing everything it should except its just displaying 1 rather than 1 to 13 (TMs).

Sub tagteamallocate()

If Sheets("Calculations").Range("AX18") > 0 Then

MsgBox "There are unrecognised room types. Please review the 'Last Night Let' column for #N/A. You can manually correct this error by selecting the correct room type on the arrive/depart screen.", vbCritical

Exit Sub
End If

If MsgBox("Warning! Any Existing Team Allocations will be Overwritten", vbOKCancel) = vbOK Then

Application.ScreenUpdating = False

Sheets("Allocations").Select
ActiveSheet.Unprotect "aladdin"
        
Range(Cells(49, 1), Cells(748, 1)).ClearContents

Sheets("Allocation Calcs").Activate

ActiveSheet.Unprotect "aladdin"

Set TMs = Range("j23")
Set HotelRooms = Cells(9, 10)
Set Proportion = Cells(10, 10)
LastRow = 4
Range(Cells(5, 19), Cells(704, 19)).ClearContents

For i = 1 To TMs.Value

Cells(2, 10) = i
HKTotal = 0
Cells(13, 10) = HKTotal
NewHKTotal = 0
Cells(14, 10) = NewHKTotal
Cells(16, 10) = 0
TargetHrs = Range("J30") * Cells(11, 10) * Cells(10, 10)

For j = LastRow - 3 To HotelRooms.Value


If (Cells(4 + j, 16) <> "Depart" And Cells(4 + j, 16) <> "Change") Or Cells(16, 10) = 1 Then


Else: NewHKTotal = HKTotal + Cells(4 + j, 18)

Cells(14, 10) = NewHKTotal

olddiff = TargetHrs - HKTotal
newdiff = TargetHrs - NewHKTotal

If olddiff > 0 And newdiff <= 0 Then

If Abs(olddiff) > Abs(newdiff) Then

Cells(4 + j, 19) = i
LastRow = 4 + j
Cells(16, 10) = 1

Else:

If Cells(4 + j, 19) = 0 Then

Cells(4 + j, 19) = i
Cells(16, 10) = 1

Else: Cells(16, 10) = 1

End If

End If

Else

Cells(4 + j, 19) = i
LastRow = 4 + j


HKTotal = NewHKTotal
Cells(13, 10) = HKTotal

End If

End If

Next
Next

ActiveSheet.protect "aladdin"
Range(Cells(5, 20), Cells(704, 20)).Copy
Sheets("Allocations").Select

Cells(49, 1).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        
Cells(49, 1).Select
ActiveSheet.protect "aladdin"
Application.ScreenUpdating = True





MsgBox "Auto allocation complete! Please review and adjust as required.             Room/s requiring manual allocation = " & Worksheets("Allocation Calcs").Cells(18, 10), vbInformation


End If

If MsgBox("Would you like to export times? This will overwrite and previous data.", vbYesNo) = vbNo Then Exit Sub

Call autoexporttimes

End Sub

Thanks
Gavin

 

[igold]

You have a lot of stuff going on here and we have no idea what your data looks like; including a couple of "IF/THEN" statements which can evaluate to an "Exit Sub". Have you stepped through the code using F8, so you can see for yourself where the code is going and if it has hit an "Exit Sub" before it gets to your "Next" statement.

As an aside, with your variables not declared, the lack of indentation and proper line spacing for legibility, it makes it more difficult to debug. I took the time to do all, and with Option Explicit enabled, the code does compile. They are good habits to get into.