Copy formulas in 4 columns down depending of last use cell in another column.

Hi.

I use 4 different formulas in range M2:P2, for getting data. ALL formulas in front of these have this condition.

=IF(A2<>"","MY FORMULA"."")

The Sheet in full action, will have some thousands of rows(I don't know how many....).

So copying down range M2:P2 for some thousands rows makes my pc slow.

My idea is to use a code that will look continiously in column A and if there are data in A, copy my formulas until this row.

Example: Range A2:A10 has data. Then Range M2:P10, FILL WITH MY FORMULAS.

A2:A500 are full? Then M2:P2 must fill with my formulas...and so on.

Any ideas?

Thanks in advance.

Hi Fotis,

Range A2:A10 has data. Then Range M2:P10, FILL WITH MY FORMULAS.

What if A2:A10 has data then A11:A15 blanks and again A16:A20 has data... ?
Do you want formula to be dragged till A20 in this type of case ?

Regards,
DILIPandey

<click on below 'star' if this helps>

Hi dillip.

Although this is unlikely to happen, the answer is: YES. Should be filled up to the row 20.

Actually i get this.

Sub Fotis()
'
'
'
LastRow = Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("m2:p2").Copy _
Destination:=Sheets("Sheet1").Range("m3:p" & LastRow)
'
End Sub

But this needs to run it using a button or RUN MACRO OPTION and i don't want to do this.

Hi Fotis,

Try below code:-

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Range("m3:p1048576").ClearContents '## enable this line if you want formula to be shrink if you delete some data from column A's bottom

i = Range("a1048576").End(xlUp).Row
Range("m2:p2").Select
Selection.AutoFill Destination:=Range("M2:P" & i)

End If
End Sub

Test the attachment:-formula fill 4 fotis.xlsm

Regards,
DILIPandey

<click on below 'star' if this helps>

This will work to and will help if formulas get cleared in columns M:P

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 1 Then
    Dim arrFormulas
    arrFormulas = Array("=SUM(B2:C2)", "=SUM(C2:D2)", "=SUM(D2:E2)", "=SUM(E2:F2)")

    Range("m2:p1048576").ClearContents

    i = Cells(Rows.Count, "a").End(xlUp).Row - 1
    If i > 0 Then
        Range("m2:p2").Resize(i) = arrFormulas
    End If
 End If
End Sub

Hi Fotis

I'd do it with a WSC event but on a line by line basis

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
Dim cell As Range
For Each cell In Target
    If cell.Value <> "" Then
        Range("M" & cell.Row).Formula = "w"
        Range("N" & cell.Row).Formula = "x"
        Range("O" & cell.Row).Formula = "y"
        Range("P" & cell.Row).Formula = "z"
    Else
        Range("M" & cell.Row & ":P" & cell.Row).Formula = ""
    End If
Next 'cell
On Error GoTo 0
Application.EnableEvents = True
End Sub

Regards, TMS

@ Dilip

Works perfectly in sample workbook but i have issues to make it to work in my real workbook.

I get some errors that i copied in the sample sheet that i upload.

@mike

So do i have to replace the line in your formulas that includes formulas

arrFormulas = Array("=SUM(B2:C2)", "=SUM(C2:D2)", "=SUM(D2:E2)", "=SUM(E2:F2)") with my real formulas?

@TMS

Works perfectly using formulas like this.

Range("M" & cell.Row).Formula = "w" but replacing with my real formulas(replacing semi colons to comma); i get nothing(no result) for the first 3 of them and the formula itself( without = in front and of course no result) for the fourth of these.

Really appreciate your efforts!

I agree with TM

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
Dim cell As Range, arrFormulas, i As Long

For Each cell In Target
    i = cell.Row
    arrFormulas = Array("=SUM(B" & i & ":C" & i & ")", "=SUM(C" & i & ":D" & i & ")", "=SUM(E" & i & ":F" & i & ")", "=SUM(G" & i & ":H" & i & ")")
    If cell.Value <> "" Then
        Cells(i, "m").Resize(, UBound(arrFormulas) + 1) = arrFormulas
    Else
        Cells(i, "m").Resize(, UBound(arrFormulas) + 1) = ""
    End If
Next 'cell
On Error GoTo 0
Application.EnableEvents = True
End Sub

@mike

So do i have to replace the line in your formulas that includes formulas

Yeap replace the sum formulas with you formulas. If you use quotes then use double quotes.

Hi Fotis,

if you tell us/me what "MY FORMULA" actually looks like for each of the columns, we can probably incorporate that.

I like Mike's array solution but I think the row will need to be adjusted for each cell.

I can cope with commas and semi-colons

Regards, TMS

Range is L2:O2(NOT m2:p2, as i said)--Sorry

in L2>>=IF(OR(M2<>"";N2<>"");D2+0;"")
in M2>>=IF($I2<0;"";IF($C3<>$C2;SUMIF($C$2:$C2;$C2;$I$2:I2)+J2;""))
in N2>>=IF($I2<0;"";IF($C3<>$C2;SUMIF($C$2:$C2;$C2;$I$2:I2)+J2;""))
in O2>>IF(AND($L2>=Sheet2!$B$2;$L2<=Sheet2!$B$3;$B2=Sheet2!$C$1);COUNT(Sheet1!$O$1:O1)+1;"")

These are my formulas

I also tried mike's suggestion using this code, but no luck!

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
Dim cell As Range, arrFormulas
arrFormulas = Array("=IF(OR(M2<>"",N2<>""),D2+0,""))", "=IF($I2<0,"",IF($C3<>$C2,SUMIF($C$2:$C2,$C2,$I$2:I2)+J2,""))", "=IF($I2>0,"",IF($C3<>$C2,SUMIF($C$2:$C2,$C2,$I$2:J2),"")))", "IF(AND($L2>=Sheet2!$B$2,$L2<=Sheet2!$B$3;$B2=Sheet2!$C$1),COUNT(Sheet1!$O$1:O1)+1,"")")
For Each cell In Target
    If cell.Value <> "" Then
        Cells(cell.Row, "l").Resize(, UBound(arrFormulas) + 1) = arrFormulas
    Else
        Cells(cell.Row, "l").Resize(, UBound(arrFormulas) + 1) = ""
    End If
Next 'cell
On Error GoTo 0
Application.EnableEvents = True
End Sub

It's not pretty but it would look something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
Dim cell As Range
For Each cell In Target
    If cell.Value <> "" Then
        Range("L" & cell.Row).Formula = _
            "=IF(OR(M" & cell.Row & "<>"""",N" & cell.Row & "<>""""),D" & cell.Row & "+0,"""")"
        Range("M" & cell.Row).Formula = _
            "=IF($I" & cell.Row & "<0,"""",IF($C" & cell.Row + 1 & "<>$C" & cell.Row & ",SUMIF($C$" & cell.Row & ":$C" & cell.Row & ",$C" & cell.Row & ",$I$" & cell.Row & ":I" & cell.Row & ")+J" & cell.Row & ",""""))"
        Range("N" & cell.Row).Formula = _
            "=IF($I" & cell.Row & "<0,"""",IF($C" & cell.Row + 1 & "<>$C" & cell.Row & ",SUMIF($C$" & cell.Row & ":$C" & cell.Row & ",$C" & cell.Row & ",$I$" & cell.Row & ":I" & cell.Row & ")+J" & cell.Row & ",""""))"
        Range("O" & cell.Row).Formula = _
            "=IF(AND($L" & cell.Row & ">=Sheet2!$B$" & cell.Row & ",$L" & cell.Row & "<=Sheet2!$B$3,$B" & cell.Row & "=Sheet2!$C$1),COUNT(Sheet1!$O$1:O1)+1,"""")"
    Else
        Range("L" & cell.Row & ":O" & cell.Row).Formula = ""
    End If
Next 'cell
On Error GoTo 0
Application.EnableEvents = True
End Sub

Not sure about the last formula so I suggest you check that out specifically ... and maybe the others.


Regards, TMS

Both codes give me the same error in a message box.

"Subscript out of range"

Option to choose OK or Help.

If i choose help, i get this.

Subscript out of range (Error 9)

Elements of arrays and members of collections can only be accessed within their defined ranges. This error has the following causes and solutions:


You referenced a nonexistent array element.
The subscript may be larger or smaller than the range of possible subscripts, or the array may not have dimensions assigned at this point in the application. Check the declaration of the array to verify its upper and lower bounds. Use the UBound and LBound functions to condition array accesses if you're working with arrays that are redimensioned. If the index is specified as a variable, check the spelling of the variable name.

You declared an array but didn't specify the number of elements. For example, the following code causes this error:
Dim MyArray() As Integer
MyArray(8) = 234 ' Causes Error 9.


Visual Basic doesn't implicitly dimension unspecified array ranges as 0 – 10. Instead, you must use Dim or ReDim to specify explicitly the number of elements in an array.

You referenced a nonexistent collection member.
Try using the For Each...Next construct instead of specifying index elements.

You used a shorthand form of subscript that implicitly specified an invalid element.
For example, when you use the ! operator with a collection, the ! implicitly specifies a key. For example, object!keyname.value is equivalent to object.item(keyname).value. In this case, an error is generated if keyname represents an invalid key in the collection. To fix the error, use a valid key name or index for the collection.


For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).

i am able to understand that maybe there are not any other ideas!

Heres another.

EDIT To: arrFormulas(1) and arrFormulas(2)

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
Dim cell As Range, arrFormulas(3), i As Long

arrFormulas(0) = "=IF(OR(M#<>"""",N#<>""""),D#+0,"""")"
arrFormulas(1) = "=IF($I#<0,"""",IF($C&<>$C#,SUMIF($C$#:$C#,$C#,$I$#:I#)+J#,""""))"
arrFormulas(2) = "=IF($I#<0,"""",IF($C&<>$C#,SUMIF($C$#:$C#,$C#,$I$#:I#)+J#,""""))"
arrFormulas(3) = "=IF(AND($L#>=Sheet2!$B$#,$L#<=Sheet2!$B$3,$B#=Sheet2!$C$1),COUNT(Sheet1!$O$1:O1)+1,"""")"
For Each cell In Target
    i = cell.Row
    If cell.Value <> "" Then
        Cells(i, "L") = Replace(arrFormulas(0), "#", i)
        Cells(i, "M") = Replace(Replace(arrFormulas(1), "#", i), "&", i + 1)
        Cells(i, "N") = Replace(Replace(arrFormulas(2), "#", i), "&", i + 1)
        Cells(i, "O") = Replace(arrFormulas(3), "#", i)
    Else
        Cells(i, "l").Resize(, UBound(arrFormulas) + 1) = ""
    End If
Next 'cell

Application.EnableEvents = True
On Error GoTo 0
End Sub

Well, I did forget to change the commas to semi-colons

Other than that, not sure why you'd get subscript out of range ... although if the sheet names don't match that might be a problem.

I've attached my code in a workbook.


Regards, TMS