How can I put this array formula using VBA?

[asad]

Hello Guys,

I got the following array formula given to me on this forum:

{=IF(A7 < > A$5,"",$A$5&" "&TEXT(MIN(IF('O:\Operations Supervisor\`Rosters 2011\[Leave  allocation 2011 Master.xls]Leave Approved'!$I$15:$I$215=$E7,IF('O:\Operations Supervisor\`Rosters 2011\[Leave  allocation 2011 Master.xls]Leave Approved'!$I$4:$FQ$4 > =$BC$1,IF('O:\Operations Supervisor\`Rosters 2011\[Leave  allocation 2011 Master.xls]Leave Approved'!$I$15:$FQ$215="",'O:\Operations Supervisor\`Rosters 2011\[Leave  allocation 2011 Master.xls]Leave Approved'!$I$4:$FQ$4-7)))),"dd/mm/yyyy"))}

It is working fine.

I want to put this formula in the ranges G8:G37, G39:G63, G67:G72 and so on. There are 8 ranges like this all in column G. Is there a way to use VBA to do this for me? The reason for this is that I got another macro that clears column G and then I am left with no formulas in there. I will add this extra bit of VBA to the existing macro so that I don't have to fill this formula in manually every time I run the original macro.

Thanks for your help.
Asad

 

[Domenic]

For an absolute reference, replace...

BJ9

with

$BJ$9

Note that we need to use the R1C1 reference style for the FormulaArray property, since it requires it, but the A1 reference style for the replacement strings (myFormaulaPart2 and myFormulaPart3), since the formula in G8 is in the A1 reference style.

 

[asad]

Thanks Domenic.
It is working perfect on my test file at home.
I will put it in the actual file at work on Tuesday and if there is any problem, I will bother you again.

Thanks a lot again for your patience and help Domenic.

Asad

 

[asad]

Domenic, I tested your formula in actual file and added it in the whole code for that file. It works perfect. Thanks a lot again.

shg: I couldn't get your code to work. When I try to run it, it does put the formula in G8 but then gives me a message that the formula is wrong. So I actually inserted the same formula as is the final formula from Domenic's code, still gives me the same message. I don't know why. I will show the code how I inserted it:-

Sub InsertLongArrayFormula(r As Range, _
sFrm As String, _
Optional sFmt As String = "General")
With r
.NumberFormat = "@"
.Value = sFrm
.NumberFormat = sFmt
Application.Goto .Cells
End With
DoEvents
Application.SendKeys "{F2}^+~"
End Sub
Sub AsadFormula()
Dim sPath As String
Dim sFrm As String

myPath = "E:\Ali Land\MrExcel\Footscray Roster\[Leave allocation 2011 Master.xls]Leave Approved"
sFrm = "=IF(RC[-6] < > ""A/L"","""",""A/L ""&TEXT(MIN(IF('" & myPath & "'!R15C9:R215C9=RC[-2],IF('" & myPath & "'!$I$4:$FQ$4 > =$BC$1,IF('" & myPath & "'!$I$15:$FQ$215="""",'" & myPath & "'!$I$4:$FQ$4-7)))),""dd/mm/yyyy""))"

' this is where you look at the formula in the Immediate window and verify it's correct
Debug.Print sFrm


InsertLongArrayFormula Range("G8"), sFrm
End Sub

"RC[-6]" gets highlighted in the cell G8 with the error message. Why is that?

Asad

 

[shg]

Change

Dim sPath As String

to

Dim myPath As String

 

[shg]

Sorry, never mind, that's not the problem (but should be fixed).

You have mixed R1C1 and A1 references in the formula. They all need to be consistent.

 

[asad]

Still Not working. Made both changes like you suggested.

Sub AsadFormula()
Dim myPath As String
Dim sFrm As String

myPath = "E:\Ali Land\MrExcel\Footscray Roster\[Leave allocation 2011 Master.xls]Leave Approved"
sFrm = "=IF(RC[-6] < > ""A/L"","""",""A/L ""&TEXT(MIN(IF('" & myPath & "'!R[15]C[9]:R[215]C[9]=RC[-2],IF('" & myPath & "'!R[4]C[9]:R[4]C[173] > =R[1]C[55],IF('" & myPath & "'!R[15]C[9]:R[215]C[173]="""",'" & myPath & "'!R[4]C[9]:R[4]C[173]-7)))),""dd/mm/yyyy""))"

' this is where you look at the formula in the Immediate window and verify it's correct
Debug.Print sFrm


InsertLongArrayFormula Range("G8"), sFrm
End Sub

Still "RC[-6]" gets highlighted in G8 with the error message. Do I have to put the references as R[15]C[9] or simply R15C9. It is supposed to be $I$15 in actual formula when done directly in the cell.

Asad

 

[shg]

Well, I think you're getting closer.

Change Excel to R1C1. When the formula prints in the Immediate window, see if you can copy and it and paste it in a cell as an array formula. If that works, we can sort it out from there.

 

[asad]

Well, I think you're getting closer.

Change Excel to R1C1. When the formula prints in the Immediate window, see if you can copy and it and paste it in a cell as an array formula. If that works, we can sort it out from there.

Sorry for the inconvenience I caused you for my mistakes. I actually got a lot closer than before just by changing the references to A1 style in the whole formula. It worked perfect.

Thanks to you shg.

Now I got two different ways of achieving what I had to achieve.

Asad

 

[shg]

Good job, asad! Glad you got it sorted.

 

[asad]

I hit another wall in the whole code.
I have inserted few lines of codes along with code Domenic gave to me. It was still working good. Then I added one more line to insert another formula. The code stops there and ask to debugg. I am showing the code below and line it highlights in yellow is highlighted in red and bold.

Private Sub CommandButton1_Click()
' Macro recorded 25/05/2011 by Ali
'
Dim myPath As String
Dim myFormulaPart1 As String
Dim myFormulaPart2 As String
Dim myFormulaPart3 As String
myPath = "E:\Ali Land\MrExcel\Footscray Roster\[Leave allocation 2011 Master.xls]Leave Approved"

myFormulaPart1 = "=IF(RC[-6]<>""A/L"","""",""A/L ""&TEXT(MIN(IF('" & myPath & "'!R15C9:R215C9=RC[-2],X_X_X)),""dd/mm/yyyy""))"
myFormulaPart2 = "IF('" & myPath & "'!$I$4:$FQ$4>=$BC$1,IF('" & myPath & "'!$I$15:$FQ$215="""",Y_Y_Y))))"
myFormulaPart3 = "'" & myPath & "'!$I$4:$FQ$4-7"
[BC1] = [BC2].Value
[E8:F35].Copy [E9:F36]
[E36:F36].Copy [E8:F8]
[E40:F63].Copy [E41:F64]
[E64:F64].Copy [E40:F40]
[E68:F72].Copy [E69:F73]
[E73:F73].Copy [E68:F68]
[E77:F81].Copy [E78:F82]
[E82:F82].Copy [E77:F77]
[E86:F93].Copy [E87:F94]
[E94:F94].Copy [E86:F86]
[E98:F119].Copy [E99:F120]
[E120:F120].Copy [E98:F98]
[E126:F153].Copy [E127:F154]
[E154:F154].Copy [E126:F126]
[E158:F179].Copy [E159:F180]
[E180:F180].Copy [E158:F158]
[E184:F187].Copy [E185:F188]
[E188:F188].Copy [E184:F184]
[E192:F195].Copy [E193:F196]
[E196:F196].Copy [E192:F192]
[BE8:BG200,A8:B200,H8:H93,H98:H119,H126:H200,E36:F36,E64:F64,E73:F73,E82:F82,E94:F94,E120:F120,E154:F154,E180:F180,E188:F188,E196:F196].ClearContents
[BE7:BG7].AutoFill Destination:=[BE7:BG200], Type:=xlFillDefault
Range("BE98:BE119").FormulaR1C1 = "=RC[-51]"
Range("D98:D119").Formula = "=INDEX(DR$98:DS$119,MATCH(F98,DR$98:DR$119,0),2)"
[A7:B7].AutoFill Destination:=[A7:B200], Type:=xlFillDefault
With Range("G8")
.FormulaArray = myFormulaPart1
.Replace "X_X_X))", myFormulaPart2
.Replace "Y_Y_Y", myFormulaPart3
End With

Range("G8").Copy
Range("G9:G35,G40:G63,G68:G72,G77:G81,G86:G93,G126:G153,G158:G179,G184:G187,G192:G195").PasteSpecial xlPasteFormulas
Range("H8:H35").Formula = "=IF(A8<>$A$5,"",index($F$98:$F$119,match(C8,$H$98:$H$119,0)))"
[BD:DJ].EntireColumn.Hidden = True
[E:E].EntireColumn.Hidden = True
[A:B].EntireColumn.Hidden = True
[H99] = "Mandeville Hall School"
[H98] = "Find Work"
[H98].Copy [H100:H119]
[H3].Select
ActiveWorkbook.SaveAs Filename:="E:\Ali Land\MrExcel\Footscray Roster\FSCY " & Format(Range("BC1").Value, "yy-mm-dd") & ".xls"
End Sub

I have successfully inserted another line (shown in blue above). I can't understand why this one is not working.

Can you help me again please?

Asad