C

#### choi1chung1gm

I need to linearly interpolate two points (X0,Y0) & (X1,Y1) to find

the New_Y value for a given New_X. The X's value increases as i go

down in column A. Say I want to find New_Y for New_X = 0.7895. I want

to lookup the two closest values of X's that New_X = 0.7895 is

between(0.7892 and 0.7897) and then use these two points to linearly

interpolate the Ys to get New_Y for New_X = 0.7895.

Example data set -

A B C D

X Y New_X New_Y

1 0.782 2.1417 0.782

2 0.7831 2.1474 0.7839

3 0.7842 2.1532 0.7858

4 0.7853 2.1592 0.7876

5 0.7864 2.1653 0.7895

6 0.7875 2.1715 0.7914

7 0.7881 2.1746 0.7932

8 0.7886 2.1778 0.7951

9 0.7892 2.181 0.797

10 0.7897 2.1843 0.7988

11 0.7908 2.1908 0.8069

12 0.7919 2.1974 0.8007 2.0298

13 0.793 2.2042

14 0.7936 2.2076

15 0.7941 2.211

16 0.7947 2.2144

17 0.7952 2.2179

18 0.7958 2.2214

19 0.7963 2.2248

20 0.7974 2.2318

21 0.7979 2.2354

22 0.7985 2.2389

23 0.799 2.2424

24 0.7996 2.246

25 0.8001 2.0321

26 0.8007 2.0298

I have a VBScript (please see at the end of this message within the

#### borders) that extracts the X and Y columns from a text file. I

need help to take it further to do the following -

(A) create column C of New_X values as follows -

- put value in C1 equal to that in A1 (or the first X)

- calculate the difference between last X and first X values (e.g.

0.8007-0.782 = 0.0187)

- calculate values for 10 cells C2, C3,...C11 using formula (C2 = C1

+ 0.0187/10), (C3=C2+0.0187/10),...(C11 = C10 + 0.0187/10)

- put C12=last X (in this example C12=0.8007) and put D12= last Y (in

this example 2.0298)

(B) A macro/VBScript to populate column D (D1 to D11) based on linear

interpolation as explained above.

I searched thru this listserve (to do the part (B)) and found

following post by Ron Rosenfeld (11/29/2005) and it works perfectly as

Excel sheet formula to get New_Y values (but I need a vb script to do

the same on the fly in my code).

=IF(NewX=MAX(x_s),MAX(y_s),VLOOKUP(NewX,tbl,2)+

(INDEX(tbl,MATCH(VLOOKUP(NewX,tbl,1),x_s)+2,2)-

VLOOKUP(NewX,tbl,2))*(NewX-VLOOKUP(NewX,tbl,1))

/(INDEX(tbl,MATCH(VLOOKUP(NewX,tbl,1),x_s)+2,1)-

VLOOKUP(NewX,tbl,1)))

I also found a VbScript by Dana DeLouis (8/11/1998) as shown below

between the asterick borders. I think that it will work for me but I

just don't understand it fully. I don't know how to call this Function

in my existing macro or how to pass the values of X (same as s1data()

in my code below), Y (same as s2data() in my code below) and New_X to

it to do the linear interpolation. Please help. Thank you all kind

people very much in advance.

Choi

***************************************************************************

' Code from Dana DeLouis

Hello. Here is a copy of 1 custom interpolating function that I use.

Most

of the code is error checking. The actual code is rather small. You

can

remove most of the error checking if you want. The code searches

Xrange to

find the 2 surrounding values close to 'Value' and interpolates along

the

Yrange to return an answer. Xrange (& Yrange) is a column of data

like

A1:A10. You do not have to manually pick the 2 surrounding Xvalues.

Note

the use of Value2 in the code. This allows you to search for a date

(just

like you want).

Any questions? Just ask. Hope this helps.

Function Interpolate(Value, XRange As Range, YRange As Range,

Optional

X_Ascending As Boolean = True)

'// Dana DeLouis: (e-mail address removed)

'// Value is the number to interpolate along the XRange

'// XRange & YRange are the table data

'// (each 1 column wide, with at least 2 rows)

'// Include X_Ascending = False if XRange in Descending order

'// otherwise, default is XRange in Ascending order

Application.Volatile

Dim Ys

Dim Xs

Dim P As Integer

On Error Resume Next

'// Adjust Value if a Date

If IsDate(Value) Then Value = CDbl(CDate(Value))

'// Check X Range for errors

If XRange.Columns.Count > 1 Or XRange.Rows.Count < 2 Then

Interpolate = "** Error, X Range"

Exit Function

End If

'// Check Y Range for errors

If YRange.Columns.Count > 1 Or YRange.Rows.Count < 2 Then

Interpolate = "** Error, Y Range"

Exit Function

End If

'// Make sure X & Y have same # of rows

If XRange.Rows.Count <> YRange.Rows.Count Then

Interpolate = "** Error, # Rows"

Exit Function

End If

With WorksheetFunction

'// Look for an exact match first

P = .Match(Value, XRange.Value2, 0) '** 0 for an exact match

If P > 0 Then

'An exact match. Just get given data

Interpolate = .Index(YRange, P, 1)

Else

If X_Ascending = True Then

P = .Match(Value, XRange.Value2, 1) '** 1 for

ascending

order!

Else

P = .Match(Value, XRange.Value2, -1) '** -1 for

descending

order!

End If

'// Make sure number falls inside XRange

'// otherwise answer may not be valid

If P = 0 Or P = XRange.Cells.Count Then

Interpolate = "# outside range"

Exit Function

End If

'// Pick surrounding cells to do a linear interpolation

Xs = Array(.Index(XRange.Value2, P,

1), .Index(XRange.Value2, P

+ 1, 1))

Ys = Array(.Index(YRange.Value2, P,

1), .Index(YRange.Value2, P

+ 1, 1))

Interpolate = .Forecast(Value, Ys, Xs)

End If

End With

End Function

***************************************************************************

##########################################################################

'choi's code

Option Explicit

Sub ProcessText()

Dim FName, FNameO As Variant

Dim MyTitle, MyFilter As String

Dim FNum As Long

Dim sLine As String

Dim i, j, k, l As Long

Dim x As Variant

Dim s1data(), s2data() As Variant

FNum = FreeFile

ReDim s1data(1 To 50000, 1 To 1)

ReDim s2data(1 To 50000, 1 To 1)

Close FNum

Imax = 1

MyTitle = "Select File(s)"

MyFilter = "MXV Files (*.mxv), *.mxv"

' MyFilter = "All Files (*.*), *.*"

Application.ScreenUpdating = False

ChDir "C:\" 'This is the starting directory to lookup files

FName = Application.GetOpenFilename(FileFilter:=MyFilter, _

Title:=MyTitle, MultiSelect:=True)

If IsArray(FName) Then

For k = LBound(FName) To UBound(FName)

Open FName(k) For Input As FNum

i = 1

Do While Not InStr(1, sLine, "TheCell # 22", vbTextCompare) > 0

Line Input #FNum, sLine

i = i + 1

Loop

Debug.Print sLine

For i = 1 To 300

Line Input #FNum, sLine

Next i

Debug.Print sLine

i = 1

Do While Not InStr(1, sLine, "EndCell# 22", vbTextCompare) > 0

Line Input #FNum, sLine

s1data(i, 1) = Right(sLine, Len(sLine) - InStr(1, sLine, "

"))

s2data(i, 1) = Left(sLine, Len(sLine) - InStr(1, sLine, "

"))

i = i + 1

Loop

Close FNum

'START_Write output

i = i - 2

ActiveWorkbook.Sheets(1).Activate

For j = 1 To i

Cells(j , 1).Value = s1data(j, 1)

Cells(j , 2).Value = s2data(j, 1)

Next j

End Sub

##########################################################################