Copying Down Formulas

[frog0234]

I am using Excel 2007 and have a spread sheet of 800 columns and 163,000 rows. In each cell of the first row are equations similar to this: =VLOOKUP(F4,Sheet2!$A$1:$ADT$571,H$3)-VLOOKUP(G4,Sheet2!$A$1:$ADT$571,H$3)

I am trying to copy down this row to row 163,000 and am only able to get to around row 15,000 before I get the message that I have run out of system resources. I have tried turning off auto calculations in the cells. What else can I do to populate the cells with the formulas?

Thanks.

[RHCPgergo]

Hey,
first select the range where you want to formula to be pasted, then run this macro.
I assumed that your selection starts in row 4. If not, tell me and I will alter the code.

Sub CopyFormula()
'I assumed that your selection starts in row 4
Dim Rng As Range
Dim i As Long
Application.ScreenUpdating = False
For Each Rng In Selection
    i = Rng.Row
    Rng.Value = "=VLOOKUP(F" & i & _
    ",Sheet2!$A$1:$ADT$571,H$3)-VLOOKUP(G " & i & _
    ",Sheet2!$A$1:$ADT$571,H$3)"
Next Rng
Application.ScreenUpdating = True

End Sub

[Pepe Le Mokko]

If you could post a small sample of your sheet so we can see what you are trying to do, it would help us a lot.
I also thing an INDEX/MATCH combination needs less resources

[frog0234]

Here is the spreadsheet I am working with. I tried the VBA code and am getting an error.

Any other ideas?

[frog0234]

Here is the file. I have removed alot of the data from Sheets 1 & 2 to allow for upload. But again, I am trying to drag down the first row of formulas about 163,000 rows. The data table in Sheet 2 has 571 rows of 800 columns.

[frog0234]

Any thoughts on this?

[RHCPgergo]

Hi again,

how about this one?
http://spreadsheets.about.com/od/tip...30filldown.htm

Applied to your case:
1. highlight your first row of data (from column C to the end)
2. press F5 (brings up the "Go to" dialog box)
3. type in the bottom right cell address of the range where you want to apply the formula (should be something like this: ADT163000)
4. click OK while holding shift (now all that huge range should be highlighted)
5. press Ctrl + D
6. formula should be applied everywhere.

Tell me if it works please.

[frog0234]

Neat trick, but it doesn't work for this situation. I first get the warning notice of "large data operation", after I click ok I get "Excel cannot complete this task with available resources. Choose less data or close other applications"

Other ideas?

[RHCPgergo]

Wow.

How about applying it in smaller chunks? Like for every ten thousand row?
Also, once you have the correct data in the cells, you can use Copy-->Paste Special-->Values, so formulas disappear. Makes the file size smaller.

[jleonard5106]

Try this code. i have also attached the file.

I created a copy of sheet 1 and named it test.

Sub CopyFormula()

Dim FinalRow As Long
Dim FinalCol As Long

Dim Ws1 As Worksheet
    
    Set Ws1 = ThisWorkbook.Worksheets("Test")

    FinalRow = Ws1.Cells(Rows.Count, 1).End(xlUp).Row - 4
    FinalCol = Ws1.Cells(4, Columns.Count).End(xlToLeft).Column - 2
    
    Ws1.Cells(5, 3).Resize(FinalRow, FinalCol).FormulaR1C1 = "=VLOOKUP(RC1,Sheet2!R1C1:R571C800,R4C)-VLOOKUP(RC2,Sheet2!R1C1:R571C800,R4C)"
    
End Sub

[frog0234]

The VBA code works to about row 7000 and then I get an error stating that there are no more system resources available to continue.

Other ideas?

[jleonard5106]

I am still working on it.

are the formulas important or just number?

[jleonard5106]

Try this Code

Took away the vlookups and just used simple subtractions

Sub CopyFormula()


Dim WsR As Worksheet 'worksheet report
Dim WsD As Worksheet 'worksheet data

'Report Sheet
Dim FinalRowWsR As Long
Dim FinalColWsR As Long
'Data Sheet
Dim FinalRowWsD As Long
Dim FinalColWsD As Long

Dim MyArray1() As Variant
Dim MyArray2() As Variant

Dim Dta As Long
Dim Crit As Long
Dim c As Long

Dim Crit1 As String
Dim Crit2 As String

Dim Crit1A As Long
Dim Crit2A As Long

Set WsR = ThisWorkbook.Worksheets("Report")
Set WsD = ThisWorkbook.Worksheets("Data")

Application.ScreenUpdating = False

FinalRowWsD = WsD.Cells(Rows.Count, 1).End(xlUp).Row
FinalColWsD = WsD.Cells(1, Columns.Count).End(xlToLeft).Column
FinalRowWsR = WsR.Cells(Rows.Count, 1).End(xlUp).Row
FinalColWsR = WsR.Cells(4, Columns.Count).End(xlToLeft).Column - 1

'loop to find the criteria row on wsd
For Crit = 5 To FinalRowWsR
    Crit1 = WsR.Cells(Crit, 1).Value
    Crit2 = WsR.Cells(Crit, 2).Value
    
    Crit1A = 0
    Crit2A = 0
    
    For Dta = 1 To FinalRowWsD
        Select Case WsD.Cells(Dta, 1).Value
            Case Crit1
                Crit1A = WsD.Cells(Dta, 1).Row
            Case Crit2
                Crit2A = WsD.Cells(Dta, 1).Row
        End Select
        
        If Crit1A And Crit2A <> 0 Then Exit For
        
    Next Dta
    'formula
    ReDim MyArray1(1 To FinalColWsD)
    ReDim MyArray2(1 To FinalColWsD)
    
    MyArray1() = WsD.Range(WsD.Cells(Crit1A, 2), WsD.Cells(Crit1A, FinalColWsD))
    MyArray2() = WsD.Range(WsD.Cells(Crit2A, 2), WsD.Cells(Crit2A, FinalColWsD))
    
    For c = 3 To FinalColWsD + 1
        WsR.Cells(Crit, c).Value = MyArray1(1, c - 2) - MyArray2(1, c - 2)
    Next c
    
    Application.StatusBar = "On Record " & Crit
    
Next Crit

Application.StatusBar = True
Application.ScreenUpdating = True
End Sub

[frog0234]

Wow, I really appreciate your work. I don't use message boards often, but it is nice to see people so willing to help others especially with the complexity to your VBA code. I started to run it, but it is taking a long time (which is ok), I will have to run it when I can walk away from the computer for a bit. I will let you know the final outcome. Thanks again. I will follow up soon.