2005/05/23

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

2005/05/13

My new Morse input method

Recently, il and I are using morse code to communicate on msn messenger. And it is not an easy way to input message. It is much easier to type a morse than to actually read it.

So, an input method is no much harm to practise the morse code. So I generated an Input Method on my powerbook, and it rocks.

2005/05/02

Fixed my powerbook.

My powerbook has sicked for a longtime. Starting from half a year ago, the DVD stuck in the CR-ROM mechanically. I went to Apple store in downtown Denver for a cure. The genius there molest the baby for about two hours, finally they gave up and said it would be about $310 to open the powerbook, and if have the DVD drive changed, will it cost 200 bucks more.

Oh, Ok, lets do it myself, it won't take 10 hours to do that.

I went to home and tried to crack it. I'd never recommend to open this pandora's box unless you have the 24 page garage guide for it. I then went to 10^100 for any clue. Thank god, some guy neatly put their photonized guide on website. I still failed to crack the DVD-ROM since I can't remove the "giant" two screws on the heat sink. Ok, let's use this laptop without CD at all!

I have used this blind laptop till recently the hard drive died. Poor as Helen Keller. Can't boot from CD, Can't boot from HD. I then bought an 80Gb HD from a cheap website for hundred bucks. And then downloaded and printed repair manual from www.pbfixit.com. And after a total of 8 hours struggle, it is running just as a sexy pig now.