VBA Code Need it to Copy Formulas

[rsrasc]

Hello all,

I have about 15 files that I have to manually copy & paste the following formula in Columns I, K, M, O, Q, S, U, W, Y, AA, AC & AE.

=IF(ISNA(VLOOKUP($C7,'FY 23 Actual + Reforecast'!$A$1:$AI$503,I$1,FALSE)),"$0.00",VLOOKUP($C7,'FY 23 Actual + Reforecast'!$A$1:$AI$503,I$1,FALSE))

The formula is to be copy right below the corresponding month (well, 12 of them), and is looking for the value associated or corresponding to what is in cell C7 (then C16, C27, C38 and so on) in this case. In the attachment you will see the formula highlighted in blue. Then I will copy the formula to cell I17, I28, and I39


With your help I would like to have a macro that will do this for me.

Please let me know if you have any questions or need additional information.

Thanks!
rsrasc

[June7]

I think figuring out the code would take longer than manual edit for 15 files. However, here are a couple of methods to consider:

Sub InputFormula()Dim r As Integer, x As Integer, y As Integer, f As String, a As String
r = 8
With Worksheets("FY24-Monthly Variance Report")
For x = 1 To 4
    For y = 1 To 12
        a = Choose(y, "I", "K", "M", "O", "Q", "S", "U", "W", "Y", "AA", "AC", "AE")
        f = "=IF(ISNA(VLOOKUP($C" & r - 1 & ",'FY 23 Actual + Reforecast'!$A$1:$AI$503," & a & "$1,FALSE)),""$0.00"",VLOOKUP($C" & r - 1 & ",'FY 23 Actual + Reforecast'!$A$1:$AI$503," & a & "$1,FALSE))"
        .Range(a & r).Formula = f
    Next
    r = r + 9
Next
End With
End Sub


Sub CopyFormula()
Dim r As Integer, x As Integer, y As Integer, a As String
With Worksheets("FY24-Monthly Variance Report")
r = 8
.Range("I8").Copy
For x = 1 To 4
    For y = 1 To 12
        a = Choose(y, "I", "K", "M", "O", "Q", "S", "U", "W", "Y", "AA", "AC", "AE")
        .Range(a & r).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    r = r + 9
Next
End With
Application.CutCopyMode = False
End Sub

[June7]

Or this

Sub CopyFormula()
Dim r As Integer, c As Integer
With Worksheets("FY24-Monthly Variance Report")
.Range("I8").Copy
For r = 8 To 35 Step 9
    For c = 9 To 31 Step 2
        .Cells(r, c).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
Next
End With
Application.CutCopyMode = False
End Sub

Note that all 3 procedures depend on the rows needing edit to be separated by 9 rows - the difference of C7 and C16. However, you are showing other separations by 11 rows. This will be much more complicated if there is no consistency.

[rsrasc]

Hi June7, I just saw your reply. I will go ahead and test it and than you for taking the time to put this together. Much appreciated!

[rsrasc]

Hi June7,

I tested your code, and they work really fast but as you stated all 3 procedures depend on the numbers of rows need it. Anything over 10 rows is indeed more complicated and there is no consistency. I wish all the files has the same numbers or rows.

I was thinking if the coding can be modified to show some matching with the information available in Column C where all the numbers stars with "5xxxx".---maybe. I'm referring to the same line where the months are listed. BTW, i need to mention that I'm not an expert with VBA. Much of the code I use are obtained from this website or other sites.

[June7]

That is a possible approach. I did say would be much more complicated. As I said, faster to do manual edit if this is a one-time exercise.

I often create new Excel VBA code with macro recorder then customize it for particular requirements. For instance, I used macro recorder to get syntax for the Copy and PasteSpecial lines. Give it a try and you can then see adjustments I made for additional automation.

[rsrasc]

Hi June7, I contacted a colleague of mine in Japan and he sent me the following code. I tested and it's working really good. I just wanted to share that with you.

Option Explicit

Sub PutAmount()
'put amount directry from "FY 23 Actual + Reforecast" to "FY24-Monthly Variance Report"
'DO NOT insert column before Total column
'DO NOT change format of Index cells (like C7,C16,C27) red font and cream interior color
'DO NOT change format other Index cell as same as Index cells
Dim i As Long, j As Long, x As Long, z As Long, zz As Long
Dim VR As Worksheet, AC As Worksheet
Set VR = Worksheets("FY24-Monthly Variance Report")
Set AC = Worksheets("FY 23 Actual + Reforecast")
Dim ACCT As Long 'account no
Dim Vcol As Long, Acol As Long 'Column No of both tabs
z = VR.Cells(Rows.Count, "C").End(xlUp).Row 'find last row number tab1
zz = AC.Cells(Rows.Count, "C").End(xlUp).Row 'find last row number tab2
For x = 1 To 12
    ' "x" is column no. Oct = 1, Nov = 2 .... if you want to update only Oct. then for x = 1 to 1
    ' or update Jan to Mar for x = 4 to 6
    Vcol = x * 2 + 7 'column no of Varinace report tab
    Acol = x + 1 ' column no of actual tab
    For i = 7 To z 'i is row no. of VR
        If VR.Cells(i, "C").font.Color = 255 And VR.Cells(i, "C").Interior.Color = 13431551 Then
             ' red fornt color and cream interior color is index
            ACCT = Left(VR.Cells(i, "C").Value, 5) 'set account no
            For j = 10 To zz
                If Left(AC.Cells(j, 1).Value, 5) = ACCT Then 'find same accounr
                    If IsNumeric(AC.Cells(j, Acol).Value) = True Then
                        VR.Cells(i + 1, Vcol).Value = AC.Cells(j, Acol).Value 'put amount
                    Else
                        VR.Cells(i + 1, Vcol).Value = "" ' if ther's no number put blank
                    End If
                    Exit For
                End If
            Next j
         End If
    Next i
Next x
MsgBox "Done"
End Sub

Sub fontcolor()
Debug.Print (Range("c7").font.Color)
Debug.Print (Range("c7").Interior.Color)
End Sub

Sub Putformula()
'put formula in "FY 23 Actual + Reforecast"
'DO NOT insert column before Total column
'DO NOT change format of Index cells (like C7,C16,C27) red font and cream interior color
'DO NOT change format other Index cell as same as Index cells
Dim i As Long, j As Long, x As Long, z As Long, zz As Long
Dim Col As String
Dim VR As Worksheet, AC As Worksheet
Set VR = Worksheets("FY24-Monthly Variance Report")
Set AC = Worksheets("FY 23 Actual + Reforecast")
Dim Vcol As Long, Acol As Long 'Column No of both tabs
Dim Str As String, Sname As String
z = VR.Cells(Rows.Count, "C").End(xlUp).Row 'find last row number tab1
zz = AC.Cells(Rows.Count, "C").End(xlUp).Row 'find last row number tab2
Sname = AC.Name
'Str = "=IF(ISNA(VLOOKUP(C7,'FY 23 Actual + Reforecast'!A1:AI503,I$1,FALSE)),""$0.00"",VLOOKUP($C7, _
'FY 23 Actual + Reforecast'!$A$1:$AI$503,I$1,FALSE))"
For x = 1 To 12
    Vcol = x * 2 + 7 'column no of Varinace report tab
    For i = 7 To z 'i is row no. of VR
        If VR.Cells(i, "C").font.Color = 255 And VR.Cells(i, "C").Interior.Color = 13431551 Then
             ' red fornt color and cream interior color is index
            Str = "=IF(ISNA(VLOOKUP(C[AcctRow],'[SheetName]'!A1:AI[EndRow[MonthColumn]1,FALSE)),""$0.00"", _
            VLOOKUP(C[AcctRow],'[SheetName]'!A1:AI[EndRow],[MonthColumn]1,FALSE))"
            Col = Replace(Cells(1, Vcol).Address(True, False), "$1", "") 'Change number to alphabet 1=A, 2=B ....
            Str = Replace(Str, "[SheetName]", Sname)
            Str = Replace(Str, "[AcctRow]", i)
            Str = Replace(Str, "[EndRow]", zz)
            Str = Replace(Str, "[MonthColumn]", Col)
            VR.Cells(i + 1, Vcol).Formula = Str 'write formula in the cell
        End If
    Next i
Next x
MsgBox "Done"
End Sub

Thank you for assisting me.

Cheers!