[ExcelVBA] RSQ calculation using VBA

 

Dear Excel VBA experts,

I had tried to modified a vba script for processing my multiple xls files. I wish I can get enlightenment through this forum.

My multiple xls files has different amount of row. The example of file as below :

A     B   C   D   E   F     G     H
-12  114  3  0.2  1   0.1  0.4   0.5
-13  112  4  0.6  1   0.1  0.4   0.8

I would like to square of H and put the results on I. So the expected output is :

A     B   C   D   E   F     G     H       I
-12  114  3  0.2  1   0.1  0.4   0.5   0.25
-13  112  4  0.6  1   0.1  0.4   0.8   0.64

The next step, I would like to calculate Rsquare using formula RSQ=(I2:I3,D2:D3), and put the RSQ results on cell J2. I had tried to modified a vba script, but the result is not good as expected. Below is my modified script:

Dim strDocPath As String
Dim strCurrentFile As String
Dim Fname As String
Application.ScreenUpdating = False
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long

LastRow1 = Range("I3").End(xlDown).Row
LastRow2 = Range("I2").End(xlDown).Row
LastRow3 = Range("D2").End(xlDown).Row
Set vX = Range("I2:I" & LastRow2)
Set vY = Range("D2:D" & LastRow3)

strDocPath = "D:\workfolder\hycom_be_daily\se_project\exploration_t_s_u\be_se2004_2006_19oct2012\be_se2007_validation\tes\"
'strCurrentFile = Dir(strDocPath & "*.*")
strCurrentFile = Dir(strDocPath & "*.xls")

Do While strCurrentFile <> ""
Workbooks.Open Filename:=strDocPath & strCurrentFile
Range("I2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]^2"
    Range("I2").Select
    Selection.Copy
    Range("I3:I" & LastRow1).Select
    ActiveSheet.Paste
    Range("J2").Select
    Application.CutCopyMode = False
    'ActiveCell.FormulaR1C1 = "=RSQ(vX, vY)"
    Application.WorksheetFunction.RSq(vX, vY)
    ActiveWorkbook.Save
    ActiveWorkbook.Close
strCurrentFile = Dir
Loop
Application.ScreenUpdating = True

Your help is really appreciated

Regards
Ed

[Non-text portions of this message have been removed]

__._,_.___

Reply via web post

Reply to sender

Reply to group

Start a New Topic

Messages in this topic (1)

Recent Activity:

• New Members 4

Visit Your Group

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use • Send us Feedback

.

__,_._,___