• If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
  • Excel articles and downloadable files provided in the articles have not been reviewed by MrExcel Publishing. Please apply the provided methods / codes and open the files at your own risk. If you have any questions regarding an article, please use the Article Discussion section.
Dermot

Code for marking formulae as a check they have been copied correctly

Excel Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
This code will make a copy of the active sheet and then mark up the formulae, using shading to show which ones have been copied, and from where. It works from left to right, top to bottom.
Solid colour = this cell has NOT been copied from left or above, ie it is new
Horizontal hatch = this cell has been copied from the left
Vertical hatch = this cell has been copied from above
Cross hatch = this cell has been copied from the left+above

The idea is to make it much easier to check a complex sheet, because you only have to check the solid coloured cells and then confirm they have been copied correctly. If there is a cell with a corrupted formula in the middle of a table, it will be a very obvious solid colour.

For obvious reasons, the code makes a copy of the sheet, and then it literally looks at each cell, copying in the formula first from left, then from above, to see if it gives the same result. This is a bit slow, but it is the only sure way to check that formulae have been copied identically.

An example is given below, including a "rogue" cell in the middle of the table with a different formula.
MarkedFormulae.jpg


VBA Code:
Sub MarkFormulae()
  Dim V As Variant, rng As Range, S As Worksheet
  Dim i As Long, j As Long, r As Long, C As Long, ii As Long, jj As Long, n As Long, skip As Boolean
  Dim vbLeft As Long, vbAbove As Long
  vbLeft = 1: vbAbove = 2
  Dim colorLeft As Long, colorAbove As Long, colorBoth As Long, colorNone As Long
  colorLeft = 16773571
  colorAbove = 10092543
  colorBoth = 6750054
  colorNone = 9486586

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False

  ActiveSheet.Copy
  Set S = ActiveSheet
  S.Cells.UnMerge

  Cells.Interior.Color = xlNone
  V = Range(Cells(1, 1), S.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 1)).Formula
  r = UBound(V, 1)
  C = UBound(V, 2)
  ReDim A(r, C) As Long

  For i = 1 To r - 1
    Application.StatusBar = "Processing " & S.Name & ": row " & i & " of " & r
    For j = 1 To C - 1
      If Left$(V(i, j), 1) = "=" Then
        Cells(i, j).Copy
        Cells(i, j + 1).PasteSpecial Paste:=xlPasteFormulas
        If Cells(i, j + 1).Formula = V(i, j + 1) Then
          A(i, j + 1) = A(i, j + 1) Or vbLeft
        End If
        Cells(i, j + 1).Formula = V(i, j + 1)
        Cells(i, j).Copy
        On Error Resume Next
          Cells(i + 1, j).PasteSpecial Paste:=xlPasteFormulas
          skip = (Err.Number <> 0)
        On Error GoTo 0
        If skip = False Then
          If Cells(i + 1, j).Formula = V(i + 1, j) Then
            A(i + 1, j) = A(i + 1, j) Or vbAbove
          End If
          Cells(i + 1, j).Formula = V(i + 1, j)
          Select Case A(i, j)
          Case vbLeft
            Cells(i, j).Interior.Pattern = xlLightHorizontal
            Cells(i, j).Interior.PatternColor = 6737151
          Case vbAbove
            Cells(i, j).Interior.Pattern = xlLightVertical
            Cells(i, j).Interior.PatternColor = 6737151
          Case vbLeft + vbAbove
            Cells(i, j).Interior.Pattern = xlGrid
            Cells(i, j).Interior.PatternColor = 6737151
          Case Else
            Cells(i, j).Interior.Color = colorNone
          End Select
        End If
      End If
    Next j
    DoEvents
  Next i

  Application.CutCopyMode = False
  Cells(1, 1).Select
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.StatusBar = False

End Sub
  • Like
Reactions: Nvablejrg
Author
Dermot
Views
1,745
First release
Last update

Ratings

0.00 star(s) 0 ratings

More Excel articles from Dermot

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top