VBA Code Translator

Gavin Harrison

New Member
Hi Guys.

I only understand basic vba code and have taken over a project at work which involves what I think is quite advanced vba. I just wondered if a kind expert had 15 minutes to in some way explain what each line basically does, then hopefully I will be able to work with it.

Much Appreciated, I know its a big ask....

Sub AutoAllocation()

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

Application.ScreenUpdating = False

Sheets("Allocations").Select

Range(Cells(49, 1), Cells(748, 1)).ClearContents

Sheets("Allocation Calcs").Select

Set TMs = Cells(7, 10)
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

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

For j = LastRow - 3 To HotelRooms

If (Cells(4 + j, 16) <> "Make" And 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

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
Application.ScreenUpdating = True

End If

End Sub

starl

This is mainly a recorded macro. I clarified the first instance of a line (for example going to a sheet), but after that, I didn't clarify

Rich (BB code):
``````Sub AutoAllocation()

'pop up message box
If MsgBox("Warning! Any Existing TM Allocations will be Overwritten", vbOKCancel, "Warning!") = vbOK Then

'stop the screen from updating - helps speed things up a little
Application.ScreenUpdating = False

Sheets("Allocations").Select 'goes to the sheet

Range(Cells(49, 1), Cells(748, 1)).ClearContents 'clears the values in A49:A748

Sheets("Allocation Calcs").Select

Set TMs = Cells(7, 10) 'assigns J7 to a variable
Set HotelRooms = Cells(9, 10) 'assigns J9 to a variable
Set Proportion = Cells(10, 10)
LastRow = 4 'assigns 4 to a variable
Range(Cells(5, 19), Cells(704, 19)).ClearContents

For i = 1 To TMs 'loops from 1 to the value in TMs. This is actually bad coding. TMs.Value would be better

Cells(2, 10) = i 'puts the current value of i in J2
HKTotal = 0 'sets the variable to 0
Cells(13, 10) = HKTotal 'puts that variable in J13
NewHKTotal = 0
Cells(14, 10) = NewHKTotal
Cells(16, 10) = 0
TargetHrs = Cells(6, 10) * Cells(11, 10) * Cells(10, 10) 'does a calculation and places assigns it to the variable

For j = LastRow - 3 To HotelRooms 'another loop, starts at Lastrow - 3 (4-3 = 1) to the value of HotelRooms (again, bad coding)

'If/Then statement, looping through cells
'first loop through 'If "P5 not equal to 'Make' AND P5 not equal to 'Depart' and P5 not equal to 'Change' or J16 not equal to 1 then do nothing - there are not instructions
If (Cells(4 + j, 16) <> "Make" And Cells(4 + j, 16) <> "Depart" And Cells(4 + j, 16) <> "Change") Or Cells(16, 10) = 1 Then

Else: NewHKTotal = HKTotal + Cells(4 + j, 18) 'else do the calculation and assign ti to NewHKTotal

Cells(14, 10) = NewHKTotal 'place the value in a cell

olddiff = TargetHrs - HKTotal 'more calculations
newdiff = TargetHrs - NewHKTotal

If olddiff > 0 And newdiff < 0 Then 'if olddiff greater than 0 and newdiff less than 0

If Abs(olddiff) > Abs(newdiff) Then 'compares the absolute values of olddiff and newdiff. If Olddiff grether than new diff
'do the following

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

Else: 'olddiff was not greater than newdiff

If Cells(4 + j, 19) = 0 Then 'if that cell value is 0, do the following

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

Else: Cells(16, 10) = 1 'if the cell value is 1, do the following, which is nothing

End If

End If

Else 'this is the Else for If olddiff > 0 And newdiff < 0 - so this is False, so do following

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

HKTotal = NewHKTotal
Cells(13, 10) = HKTotal

End If

End If

Next 'next j
Next 'next i

'after the above loops are done
Range(Cells(5, 20), Cells(704, 20)).Copy 'copy the range
Sheets("Allocations").Select 'go to this sheet

Cells(49, 1).Select 'select this cell

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False 'do a paste special - values only (no formatting or formulas)

Cells(49, 1).Select
Application.ScreenUpdating = True 'turn ScreenUpdating back on

End If

End Sub``````