Highlight cells using VBA

[Zunit]

Hi,

I am running a macro to make some changes to certain cells in a spreadsheet (formula changes)

Is there a code I can include within the macro so that all cells that change are also highlighted in yellow?

 

[MARK858]

I think you will need to post your current macro.

 

[Zunit]

Hi,

The existing code is:

Dim strpage As StringDim objpage As Object
Dim strrange As String
Dim objrange As Object
Dim wb As Object


Sub run_update()


UserForm1.Show


End Sub


Sub file_update(file_name As String)


Dim strformula As String
Dim count As Integer


ThisWorkbook.Sheets(1).Cells(5, 1).Select


count = 0


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


On Error GoTo traperror


Set wb = Workbooks.Open(Filename:=file_name, UpdateLinks:=0)


Do Until ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 0).Value = ""
    
    strpage = ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 1)
    strrange = ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 2)
    strformula = ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 3)
  
    Set objpage = wb.Sheets(strpage)
    Set objrange = objpage.Range(strrange)
    
    objpage.Unprotect Password:="BUDPASS"
    objrange.Formula = strformula
    objrange.Locked = False
    objpage.Protect Password:="BUDPASS"
           
    count = count + 1
   
Loop


With Application
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = False
    With ActiveWorkbook
        .Save
        .Close
    End With
    .DisplayAlerts = True
End With


MsgBox count & " Formulas Successfully Updated!!"


Exit Sub


traperror:


MsgBox "Formulas Not All Updated!!! - " & count




End Sub

 

[MARK858]

At first glance it looks like(untested) that all you need is to add the line in red but give it a try on a copy of your data. If it doesn't do what you expect post back with a small sample of your data test on.

Dim strpage As String
Dim objpage As Object
Dim strrange As String
Dim objrange As Object
Dim wb As Object


Sub run_update()


UserForm1.Show


End Sub


Sub file_update(file_name As String)


Dim strformula As String
Dim count As Integer


ThisWorkbook.Sheets(1).Cells(5, 1).Select


count = 0


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


On Error GoTo traperror


Set wb = Workbooks.Open(Filename:=file_name, UpdateLinks:=0)


Do Until ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 0).Value = ""
    
    strpage = ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 1)
    strrange = ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 2)
    strformula = ThisWorkbook.Sheets(1).Cells(5, 1).Offset(count, 3)
  
    Set objpage = wb.Sheets(strpage)
    Set objrange = objpage.Range(strrange)
    
    objpage.Unprotect Password:="BUDPASS"
    objrange.Formula = strformula
    [COLOR=#ff0000]objrange.Interior.ColorIndex = 6[/COLOR]
    objrange.Locked = False
    objpage.Protect Password:="BUDPASS"
           
    count = count + 1
   
Loop


With Application
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = False
    With ActiveWorkbook
        .Save
        .Close
    End With
    .DisplayAlerts = True
End With


MsgBox count & " Formulas Successfully Updated!!"


Exit Sub


traperror:


MsgBox "Formulas Not All Updated!!! - " & count




End Sub

 

[Zunit]

That worked. Thanks.

 

[MARK858]

Your welcome, thanks for the feedback