VB code for automatic input formulae

Sub MacroFormulaInput()
'This Macro change some values of some Columns into Formulae

Dim RowNumber As Integer
Dim ColNumber As Integer

Dim EndRowNumber As Integer
Dim EndColNumber As Integer

Dim ColFormula As String
Dim i As Integer
Dim j As Integer
Dim t As Integer
Dim k As Integer

Dim FlagStr As Boolean
Dim FlagFound As Boolean
Dim FlagFirst As Boolean
Dim VarTitle As String
Dim VarRight As String
Dim VarLeft As String
Dim ColAddress As String
Dim SomeAddress As String
Dim ColAddressEnd As String
Dim FormulaStr As Variant

Dim sht As Worksheet
Set sht = ActiveSheet

FormulaStr = Array("@%MTDUnitChg@=(@TYMTDPOSUnits@/@LYMTDPOSUnits@-1)*100", "@%MTDSaleschg@=(@TYMTDPOSSales@/@LYMTDPOSSales@-1)*100", _
"@MTDGM$Difference@=@TYMTDGM$@-@LYMTDGM$@", _
"@SalesChgPriorQtr@=100*(@TYPriorQtrSales@/@LYPriorQtrSales@-1)", _
"@%MTDGM$Chg@=(@MTDGM$Difference@/@LYMTDGM$@)*100", _
"@GP%PriorQtr@=@PriorQtrGP$@/@TYPriorQtrSales@", _
"@TYMTDGM%@=@TYMTDGM$@/@TYMTDPOSSales@*100", "@%YTDUnitsChg@=(@TYYTDUnits@/@LYYTDUnits@-1)*100", _
"@LYMTDGM%@=@LYMTDGM$@/@LYMTDPOSSales@*100", "@%YTDSalesChg@=(@TYYTDPOSSales@/@LYYTDPOSSales@-1)*100", _
"@MTDGM%Difference@=@TYMTDGM%@-@LYMTDGM%@", "@YTDGM$Difference@=@TYYTDGM$@-@LYYTDGM$@", _
"@MTDGM%BasisPtsDiff@=@MTDGM%Difference@*100", "@%YTDGM$Chg@=(@TYYTDGM$@-@LYYTDGM$@)/@LYYTDGM$@*100", _
"@MTDGP$Difference@=@TYMTDGP$@-@LYMTDGP$@", "@TYYTDGM%@=@TYYTDGM$@/@TYYTDPOSSales@*100", _
"@%MTDGP$Chg@=@MTDGP$Difference@/@LYMTDGP$@*100", "@LYYTDGM%@=@LYYTDGM$@/@LYYTDSales@*100", _
"@%UnitsChg@=(@TYUnits@/@LYUnits@-1)*100", "@YTDGMBasisPtDiff@=@YTDGM%Chg@*100", _
"@%SalesChg@=(@TYPOSSales@/@LYPOSSales@-1)*100", "@TYMTDGP%@=@TYMTDGP$@/@TYMTDPOSSales@*100", "@LYMTDGP%@=@LYMTDGP$@/@LYMTDPOSSales@*100", _
"@MTDGP%Difference@=@TYMTDGP%@-@LYMTDGP%@", "@MTDGP%BasisPtsDiff@=@MTDGP%Difference@*100", "@GM$Difference@=@TYGM$@-@LYGM$@", _
"@%GM$Chg@=(@GM$Difference@/@LYGM$@)*100", "@TYGM%@=@TYGM$@/@TYPOSSales@*100", _
"@LYGM%@=@LYGM$@/@LYPOSSales@*100", "@GM%Chg@=@TYGM%@-@LYGM%@", _
"@BasisPtDiff@=@GM%Chg@*100", "@GP$Difference@=@TYGP$@-@LYGP$@", _
"@%GP$Chg@=@GP$Difference@/@LYGP$@*100", "@YTDGP$Difference@=@TYYTDGP$@-@LYYTDGP$@", _
"@TYGP%@=@TYGP$@/@TYPOSSales@*100", "@%YTDGP$Chg@=@YTDGP$Difference@/@LYYTDGP$@*100", _
"@LYGP%@=@LYGP$@/@LYPOSSales@*100", "@TYYTDGP%@=@TYYTDGP$@/@TYYTDPOSSales@*100", _
"@GP%Chg@=@TYGP%@-@LYGP%@", "@LYYTDGP%@=@LYYTDGP$@/@LYYTDPOSSales@*100", _
"@GPBasisPtDiff@=@GP%Chg@*100", "@YTDGM%Chg@=@TYYTDGM%@-@LYYTDGM%@", _
"@%SalesChgPriorQtr@=@TYPriorQtrSales@/@LYPriorQtrSales@", "@YTDGP%Chg@=@TYYTDGP%@-@LYYTDGP%@", _
"@GP%PriorQtr@=@PriorQtrGP$@/@TYPriorQtrSales@", "@YTDGPBasisPtDiff@=@YTDGP%Chg@*100")
Max = UBound(FormulaStr)

EndRowNumber = 1
EndColNumber = 1

EndRowNumber = ActiveCell.SpecialCells(xlLastCell).Row
EndColNumber = ActiveCell.SpecialCells(xlLastCell).Column

If EndRowNumber < 1 Then
Exit Sub
ElseIf Cells(EndRowNumber, 1).Value = "" Then
EndRowNumber = EndRowNumber - 1
End If

On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler

For k = 0 To Max
ColFormula = FormulaStr(k) 'pick up the formula for the column

i = 1
j = 1
FlagFormula = False
FlagFound = False
i = InStr(i, ColFormula, "@", vbTextCompare) 'find the first "@"
FlagStr = True
'true: the beginning "@", i is at position of starting a variable, false: the ending "@"
FlagFirst = True
'true: first variable in the formula, which is on the left hand side of the equation
'false: variables on the right hand side of the equation
Do While i > 0
If FlagStr Then
j = InStr(i + 1, ColFormula, "@", vbTextCompare) 'j is the position of the end of the variable
VarTitle = Mid(ColFormula, i + 1, j - i - 1) 'grab the title of the variable starting at i ending at j
VarLeft = Left(ColFormula, i - 1) 'left side string of the whole formula
For ColNumber = 1 To EndColNumber 'scan the whole sheet for the title

'check if the title of the variable is in the spreadsheet
If StrComp(VarTitle, sht.Cells(1, ColNumber).Value, 1) = 0 Then

If Not FlagFound Then
FlagFound = True 'the title has been found
FlagFormula = True
FlagStr = False

If FlagFirst Then

'ColAddress is the starting address where to put the evaluation of the formula
ColAddress = sht.Cells(2, ColNumber).Address

'The code underneath is to get rid of "$" in the address
'The address was something like "$AF$321"
ColAddress = Right(ColAddress, Len(ColAddress) - 1) 'cut the first "$"
t = InStr(1, ColAddress, "$") 'find the second "$"
ColAddress = Left(ColAddress, t - 1) & Right(ColAddress, Len(ColAddress) - t) 'drop the second "$"
'

ColAddressEnd = sht.Cells(EndRowNumber, ColNumber).Address 'the ending address where to put the evaluation of the formula
VarRight = Right(ColFormula, Len(ColFormula) - j - 1) 'cut the left hand side of the equation
ColFormula = VarRight
FlagFirst = False
Else

'SomeAddress is address of variable inside the right hand side of equation of the formula
VarRight = Right(ColFormula, Len(ColFormula) - j)

'The code underneath is to get rid of "$" in the address
SomeAddress = sht.Cells(2, ColNumber).Address
SomeAddress = Right(SomeAddress, Len(SomeAddress) - 1)
t = InStr(1, SomeAddress, "$")
SomeAddress = Left(SomeAddress, t - 1) & Right(SomeAddress, Len(SomeAddress) - t)
'

ColFormula = VarLeft & SomeAddress & VarRight
End If
Else
MsgBox ("There are at least two Columns have same name: " & VarTitle & " . I am not smart enough, please fix this problem.")
Exit Sub
End If
End If

Next ColNumber
If Not FlagFound Then
MsgBox (VarTitle & " has not been found. Forumla No." & k)
FlagFormula = False
Exit Do
End If
Else 'if Flagstr
i = InStr(1, ColFormula, "@", vbTextCompare)
FlagStr = True
FlagFound = False
End If

Loop

If FlagFormula Then
ColFormula = "=IF(ISERROR(" & ColFormula & "),0,(" & ColFormula & "))"
MsgBox (ColFormula & " will be given to " & ColAddress & ". Formula No." & k)
sht.Range(ColAddress).Formula = ColFormula
sht.Range(ColAddress).Select
Selection.AutoFill Destination:=sht.Range(ColAddress & ":" & ColAddressEnd), Type:=xlFillDefault
End If
Next k

GoTo handleNormal

handleCancel:
sht.Visible = True
sht.Activate
MsgBox ("There were some error on formula No." & k)
MsgBox ("The error formula was: " & FormulaStr(k))

handleNormal:

End Sub