Migrate old QBasic program code to VBA?

Hi,

Bit of a longish post ....

Reviewing some seriously old data I created a long time ago and got a challange running this on almost anything modern. Running dosbox and vmware dos 5.0 works but obviously still more than painful getting data out so I started to recode into C and then throught might be easier to do this in Excel with VBA so I get all the graphing and intergration with other documents (like Word) options. Done a small amount of VBA so was suggested I ask on the math vba forum.

Got huge numbers of old (15-20 years old) data sets to go through. Converting the data and loading it into Excel is so far the real easy bit. And already available in csv datafiles.

The original data (experimentally created) consisted of 10 sets of 200 data points and the x and y axis are x is time and Y is some value. The data, 9 times out of ten, is pretty simple exponential decay plot. Excel (2003 not got 2007) when using the solver gets the fit mostly right, and you then get the opportunity to plot nice fancy graphs etc and incorporate those in Word docs etc which is why I am doing this. The excel fitter does not handle the data weighting etc... The old way was we used a qbasic program to obtain the fit then a dos based graphing package and I printed out the graph (on old 24 pin dot matrix printer), cut and pasted (literally with scissors and glue) the graph and it was pasted into a word processed document. The editor was Wordstar if anyone remembers that.

How times have chnaged and what I'd like to find out is could I write the original fitting and solve in VBA? I am sure MathCad or similar code does something similar but cannot seem to deal with the weighting and the routine did it all pretty simply.

The code does a least square fit to solve for Y. Pretty simple Y=Ae^x + B

It opens each scan file in turn and puts the values in an array [Value(AvFileNum,DataPoint)] That isn't required as I can put the data into a block of cells so AveFileNum would be the columns and data point the rows. 10 files, 11 colums (one is X) in all ten columns are the data. Make sense?

Obtain the average of the data points taking account of weighting etc (random data values were sometimes created due to experimental factors, noise etc):

FOR FileValuePos = 1 TO 200
FOR AvFileNum = 1 TO NoOfScans
LET Sumsquared# = Sumsquared# + Value(AvFileNum, FileValuePos) ^ 2
LET Sum# = Sum# + Value(AvFileNum, FileValuePos)
NEXT AvFileNum
IF Sumsquared# = 0 THEN LET Standev(FileNo, FileValuePos) = 0: GOTO 88
IF Sumsquared# - ((Sum# ^ 2) / (NoOfScans)) <= 0 THEN Standev(FileNo, FileValuePos) = 0: GOTO 88
LET Standev(FileNo, FileValuePos) = SQR((Sumsquared# - ((Sum# ^ 2) / (NoOfScans))) / (NoOfScans - 1))
88 IF Sum# = 0 THEN LET Average(FileNo, FileValuePos) = 0: GOTO 89
LET Average(FileNo, FileValuePos) = Sum# / (NoOfScans)
89 IF Standev(FileNo, FileValuePos) < .0001 THEN LET Standev(FileNo, FileValuePos) = .0001
LET Weight(FileNo, FileValuePos) = 1 / ((Standev(FileNo, FileValuePos)) ^ 2)
LET Sum# = 0
LET Sumsquared# = 0
NEXT FileValuePos

The little IF deal with data glitches.

So you might then obtain an 12th Column of the averaged data values, a 13th of the standard deviation and a 13th of the Weight. So far you could just progress formulae across the extra columns to get the same result.

Then the data is fitted:
endpoint is 10 less than last data point and numdat is the number of data points, this gets you a base line value
maximum if the peak of the data (usually the first data point but sometimes first one or two were 0, again experimental.
Perhaps the two sets of values endpoint and maximum should/could be placed into a cell?

' Finds intitial estimate of K
LET d = Average(FileNo, endpoint) - Average(FileNo, NumDat - 1)
IF d <= 0 THEN LET d = 1

' Initial estimate of K'
LET k = (LOG(Average(FileNo, maximum) - Average(FileNo, NumDat - 1)) - LOG(ABS(d))) / ((endpoint - maximum) * Spacing(FileNo))

LET Sum1# = 0
FOR i = maximum TO endpoint
LET Sum1# = Sum1# + Weight(FileNo, i)
NEXT i

55 LET Sum2# = 0: LET Sum3# = 0: LET Sum4# = 0: LET Sum5# = 0: LET Sum6# = 0

FOR i = maximum TO endpoint
LET z(i) = EXP(-k * Spacing(FileNo) * i)
LET Sum2# = Sum2# + (z(i) * Weight(FileNo, i))
LET Sum3# = Sum3# + (z(i) ^ 2 * Weight(FileNo, i))
LET Sum4# = Sum4# + (Average(FileNo, i) * Weight(FileNo, i))
NEXT i

FOR i = maximum TO endpoint
LET Sum5# = Sum5# + ((Average(FileNo, i) * Sum1# * Weight(FileNo, i) * z(i)) - (Sum4# * Weight(FileNo, i) * z(i)))
LET Sum6# = Sum6# + (Sum2# * Weight(FileNo, i) * z(i))
NEXT i


LET a = Sum5# / ((Sum1# * Sum3#) - Sum6#)
LET B = (Sum4# - (a * Sum2#)) / Sum1#
LET Sum5# = 0: LET Sum6# = 0

FOR i = maximum TO endpoint
LET Q = (Spacing(FileNo) * i) * z(i) * Weight(FileNo, i)
LET Sum5# = Sum5# + ((Average(FileNo, i) - (a * z(i)) - B) * Q)
LET Sum6# = Sum6# + (((2 * a * z(i)) - Average(FileNo, i) + B) * (Spacing(FileNo) * i) * Q)
NEXT i


LET delta = Sum5# / Sum6#
LET fdone = ABS(.000001 * k / delta)
LET k = k - deltadelta * delta

'basic loop until gets the fit accurate.
IF ABS(delta / k) < .000001 THEN GOTO 9888

GOTO 55

9888 PRINT k

The program then does some bits associated with plotting the decay and fit and then saving the data so that it can be used to create those graphs I mention.

Can the above be done in VBA?

Sure it can be done in VBA. You might actually get a better response on the VBA boards, since this has very little to do with math--you seem to want a translation instead of a solution.

Quote:

---

Originally Posted by jemidiah

Sure it can be done in VBA. You might actually get a better response on the VBA boards, since this has very little to do with math--you seem to want a translation instead of a solution.

---

OK will post to VBA board.