Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Arrays and Workbooks

Status
Not open for further replies.

risk99

Technical User
Mar 23, 2003
44
US
Hello! If I have the following situation:

File1.xls :
Sheets("1") has "Array1"
Sheets("2") has "Array2"

File2.xls :
Sheet("1") has "Array1"
Sheet("2") has "Array2"

All the Arrays have the same size (5x5).

I want to calculate the average array for the above four (4) arrays, and put it in to fileNew.xls. I want to make a loop in my VBA codes. But, I just don't know how to start. THANK YOU VERY MUCH FOR YOU HELP!!!
 
Hi risk99,

You really don’t want loopy code for this. The way to do it is to put a formula in one cell of your new array, say the top left one, and then to copy it to all the other cells, and then, if you want, to replace the formulae with actual result values instead of leaving in the links to the other workbooks.

As example, if all the arrays started in A1, put the following in A1 in your new sheet:

Code:
=AVERAGE([File1.xls]Sheet1!A1, [File1.xls]Sheet2!A1,[File2.xls]Sheet1!A1, [File2.xls]Sheet2!A1)

To do this in code might be a bit clumsy depending on the exact requirements but the following will more or less do it for the example you quote, not knowing where the ranges will be in the sheets:

Code:
Dim myBook As Workbook, mySheet As Worksheet
Dim Ref1 As String, Ref2 As String, Ref3 As String, Ref4 As String
    
Set myBook = Workbooks("File1")
    
Set mySheet = myBook.Worksheets("1")
Ref1 = mySheet.Range("Array1").Cells(1, 1).Address
Ref1 = WorksheetFunction.Substitute(Ref1, "$", "")
Ref1 = "[" & myBook.Name & "]" & mySheet.Name & "!" & Ref1

Set mySheet = myBook.Worksheets("2")
Ref2 = mySheet.Range("Array2").Cells(1, 1).Address
Ref2 = WorksheetFunction.Substitute(Ref2, "$", "")
Ref2 = "[" & myBook.Name & "]" & mySheet.Name & "!" & Ref2

Set myBook = Workbooks("File2")
    
Set mySheet = myBook.Worksheets("1")
Ref3 = mySheet.Range("Array1").Cells(1, 1).Address
Ref3 = WorksheetFunction.Substitute(Ref3, "$", "")
Ref3 = "[" & myBook.Name & "]" & mySheet.Name & "!" & Ref3

Set mySheet = myBook.Worksheets("2")
Ref4 = mySheet.Range("Array2").Cells(1, 1).Address
Ref4 = WorksheetFunction.Substitute(Ref4, "$", "")
Ref4 = "[" & myBook.Name & "]" & mySheet.Name & "!" & Ref4

Workbooks(“FileNew.xls”).Sheets(1).Range("A1").Formula = _
        "=AVERAGE(" & Ref1 & "," & Ref2  & "," & Ref3 & "," & Ref4 & ”)"

When you have your formula in the first cell then copy it to the entire range and then, if you want, copy the range to itself but use Paste Special – Values instead of Paste

To do this in code:

Code:
Workbooks("fileNew.xls").Sheets(1).Range("A1").Copy Destination:=Workbooks("fileNew.xls ").Sheets(1).Range("A1:E5")
Workbooks("fileNew.xls ").Sheets(1).Range("A1:E5").Copy
Workbooks("fileNew.xls ").Sheets(1).Range("A1:E5").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

Enjoy,
Tony
 
Tony,

Thank you very much for your kind response!!! The reason that I wanted to do this in a loop was because my original problem is not as simple as the one provided. Say if I have 100 sheets, and 100 arrays in each file. Then I don' think I can do it in a manual way. Thank you!!!
 
Well, that makes it a different proposition. The AVERAGE function only takes 30 arguments; if you've got 10,000 you really do need code!

You either need some naming convention to enable identification of workbooks, worksheets, named ranges, etc, or you can just process all of them. The following code takes, as a driver, the named range to receive the averages and, for each cell in it, runs through corresponding cells in every other named range in all the open workbooks adding up the total and then divides it by the number of ranges.

Code:
Dim myWorkbook As Workbook
Dim myRange As Range

Dim myDriver As Range
Dim myCell As Range

Dim myCol As Integer
Dim myRow As Long

Dim myTotal As Long
Dim myDivisor As Long

Dim bFirstPass as Boolean
Dim i As Integer

bFirstPass = True
myDivisor = 0

Set myDriver = Workbooks("fileNew").Worksheets(1).Range("
Code:
MasterRangeName
Code:
")

For myCol = 1 To myDriver.Columns.Count
    For myRow = 1 To myDriver.Rows.Count

        myTotal = 0
    
        For Each myWorkbook In Workbooks
            If myWorkbook.Name <> &quot;fileNew.xls&quot; Then
                If bFirstPass Then
                    myDivisor = myDivisor + myWorkbook.Names.Count
                End If 
                For i = 1 To myWorkbook.Names.Count
                    Set myRange = myWorkbook.Names(i).RefersToRange
                    myTotal = myTotal + myRange.Cells(myRow, myCol)
                Next
            EndIf
        Next

        bFirstPass = False
    
        myDriver.Cells(myRow, myCol).Formula = myTotal / myDivisor
    
    Next
Next

Enjoy,
Tony
 
Tony,

THANK YOU SO SO MUCH FOR THE REPLY!!!

Basically, I followed your codes very well, except for few lines:

Set myRange = myWorkbook.Names(i).RefersToRange

Let's go back to my original post:

File1.xls :
Sheets(&quot;1&quot;) has &quot;Array1&quot;
Sheets(&quot;2&quot;) has &quot;Array2&quot;

File2.xls :
Sheet(&quot;1&quot;) has &quot;Array1&quot;
Sheet(&quot;2&quot;) has &quot;Array2&quot;

I tried to set my loop as follow, but it didn't work :( please tell me what's wrong here.

For i = 1 To myWorkbook.Names.Count
For j = 1 To 2
Set myRange = Workbooks(&quot;File&quot; & i).Sheets(j).Range(&quot;Array&quot; & j)
myTotal = myTotal + myRange.Cells(myRow, myCol)
Next
Next



THANK YOU VERY MUCH, TONY!!!
 
Hi risk99,

Without seeing more I can't really tell. The code works in isolation but it may be that you're doing things twice because, for each workbook, you are processing ranges in two workbooks (just a guess).

If you post a bit more info I'll have a look at it tomorrow.

Enjoy,
Tony
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top