Loop not Looping!

Gavin Harrison

New Member
Joined
May 2, 2017
Messages
34
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).
Code:
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
 
Last edited by a moderator:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
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.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top