VBA Code Need it to Copy Formulas

[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!