VBA Code Translator

[Gavin Harrison]

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
ActiveSheet.Unprotect "password"

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

Sheets("Allocation Calcs").Select

ActiveSheet.Unprotect "password"

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

ActiveSheet.protect "password"
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 "password"
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

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
    ActiveSheet.Unprotect "password" 'unprotects that sheet
 
    Range(Cells(49, 1), Cells(748, 1)).ClearContents 'clears the values in A49:A748
 
    Sheets("Allocation Calcs").Select
 
    ActiveSheet.Unprotect "password"
 
    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
    ActiveSheet.Protect "password" 'protect the sheet
    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
    ActiveSheet.Protect "password"
    Application.ScreenUpdating = True 'turn ScreenUpdating back on
 
End If
 
End Sub

 

[Gavin Harrison]

Thank you very much for your reply.