VBA Code to Copy Info

Hello all,

In my previous post from today, I was using two similar VBA codes to copy across (to the right) the information showing in Column F for those rows showing “Budget” and % Change.

Since there are formulas in there, it works well for me.


So, I was trying to use some of that code to do something similar or do the same for the “Prior Actual” information showing in Column F but it doesn’t work for me.

In the attachment, I marked in yellow the cells that needs to be completed.

For example, the following cells has these values, and also there is a formula in there such as:

Code:

---

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

---

H14 = 2,633.84
J14 = 2,883.55
L14 = 2,974.07
N14 = 1,886.85



And so on.

Therefore, with a macro I would like to copy just the values to the cells marked in yellow.

Not sure if the cell reference can be used, let’s say for example in cell I14, I would like to have the following value: =H14 and so on.

Thank you all for your assistance and cooperation.

Cheers!

Q: Do you want (for ex) 2633.84 copied to the yellow cell next to it?

As a value or as a formula (=h14)


Attachment 31205

Q; The other worksheet has yellow cells. Just ignore them?

As a formula will be great.

It possible, if you can also add a code as a value that will be great. May need it in the future.

I forgot to say, yes, copied to the yellow cell next to it?

Q; The other worksheet has yellow cells. Just ignore them? Also, forgot to answer this one? Yes, just ignore it.

These key off the interior color of the destination cell, i.e. Yellow

If you wanted something different, like "Prior Actual" in col F and the second of each month-pair that could be done similarily

Code:

---

Option Explicit


Sub InsertAsFormula()
    Dim rData As Range, rCell As Range
    Dim bScreen As Boolean, bCalc As XlCalculation
   
    bScreen = Application.ScreenUpdating
    bCalc = Application.Calculation
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
   
    With ActiveSheet
        Set rData = Intersect(.UsedRange, .Cells(7, 8).Resize(, 24).EntireColumn)
    End With
   
    For Each rCell In rData.Cells
        With rCell
            If .Interior.Color = vbYellow Then
                .Formula = "=" & .Offset(0, -1).Address
            End If
        End With




    Next
   
    Application.ScreenUpdating = bScreen
    Application.Calculation = bCalc
   
    MsgBox "Done"


End Sub


Sub InsertAsValue()
    Dim rData As Range, rCell As Range
    Dim bScreen As Boolean, bCalc As XlCalculation
   
    bScreen = Application.ScreenUpdating
    bCalc = Application.Calculation
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
   
    With ActiveSheet
        Set rData = Intersect(.UsedRange, .Cells(7, 8).Resize(, 24).EntireColumn)
    End With
   
    For Each rCell In rData.Cells
        With rCell
            If .Interior.Color = vbYellow Then
                .Value = .Offset(0, -1).Value
            End If
        End With




    Next
   
    Application.ScreenUpdating = bScreen
    Application.Calculation = bCalc
   
    MsgBox "Done"


End Sub

---

Hi Paul,

Thank you for the code. I'm in Germany so I will test your code in my morning. It's 10:37 PM here so will let you know how it goes. Thank you for taking the time to put this together. Much appreciate it.