vba script to calculate data across multiple columns

Hi all,

i have a rather large data sheet that i need to perform a calculation on by a fixed amount per column

i have around 300 columns of data, with around 600 rows, i have written this script which performs the calculation on a single column of data, but need to expand it to cover all columns of data

Sub Macro1()
'
' Macro1 Macro
'
Dim LastRow As Long
Dim i As Long
LastRow = 111
    For i = 3 To LastRow
      Range("D" & i).Value = Range("D" & i).Value / Range("D1").Value
    Next i
'
End Sub

here is a sample of my dataset

4.7239 4.7239 4.7239 2.3021
COmpany1 Company2 Company3 Company4
-203222 300000 2000000 -4443322
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0

Hi pchappo

Welcome to the forum....
In future please view the forum rules before posting. Your post does not comply with rule #3.

3. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the [#] button at the top of the post window.

Can give this a go...

Option Explicit

Sub Calculate()
Dim lRow, lCol, i, ii As Long
Application.ScreenUpdating = False
With Sheet1
    lRow = .Cells(Rows.Count, "D").End(xlUp).Row
    lCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    For i = 4 To lCol
        For ii = 3 To lRow
            .Cells(ii, i).Value = .Cells(ii, i).Value / .Cells(ii, i).Value
        Next ii
    Next i
End With
Application.ScreenUpdating = True
End Sub

.Cells(ii, i).Value = .Cells(ii, i).Value / .Cells(1, i).Value

Hello
Can you post sample of your workbook?

300x600 = 180000 calculations.

My advice would be to load entire range into array, perform calculations in memory and write array back to worksheet.

@ bakerman2
So this stores calculated value in array...How to populate range with arr values?

Option Explicit

Sub calculate()
Dim CalcArr As Variant
Dim lRow, lCol, i As Long
Dim rng, cell As Range
lRow = Cells(Rows.Count, "D").End(xlUp).Row
lCol = Cells(3, Columns.Count).End(xlToLeft).Column
With Sheet1
    i = 1
    Set rng = .Range(.Cells(3, 4), .Cells(lRow, lCol))
    CalcArr = rng.value
    For i = LBound(CalcArr) To UBound(CalcArr)
        CalcArr(i, 1) = CalcArr(i, 1) / .Range("D1")
    Next i
End With
rng.value = CalcArr
End Sub

Edited...Nope Not storing used range!!!

something like this.

Sub tst()
    sn = Cells(1).CurrentRegion.Value 'load entire range in array
    For i = 3 To UBound(sn) 'start from row 3
        For ii = 4 To UBound(sn, 2) 'start from column 4
            sn(i, ii) = sn(i, ii) * sn(1, ii) 'perform each calculation
        Next ' next column
    Next ' next row
    Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn 'write entire array back to worksheet
End Sub

@ bakerman2...
Why does this only store the first column values in the code in post 7?

CalcArr = rng.value

Edited...How bout this....

Option Explicit

Sub Calculate()
Dim CalcArr() As Variant
Dim lRow, lCol, i, j As Long
Dim rng As Range
Application.ScreenUpdating = False
lRow = Cells(Rows.Count, "D").End(xlUp).Row
lCol = Cells(3, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(3, 4), Cells(lRow, lCol))
ReDim Preserve CalcArr(3 To lRow, 4 To lCol)
For i = 3 To UBound(CalcArr, 1)
    For j = 4 To UBound(CalcArr, 2)
        CalcArr(i, j) = Cells(i, j) / Cells(1, 4)
    Next j
Next i
rng.Value = CalcArr
Application.ScreenUpdating = True
End Sub