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)


Capture.JPG

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.