VBA Code to Copy Info

[rsrasc]

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:


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

[Paul_Hossler]

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

As a value or as a formula (=h14)


31205

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

[rsrasc]

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.

[rsrasc]

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

[rsrasc]

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

[Paul_Hossler]

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



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

[rsrasc]

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.