Diamond painting in Excel

Bored during COVID lockdown? Here is how you can virtually diamond paint using Excel! For the sake of it, I’ll show how to use a pallet and VBA to allow changing the color fast 🙂

1. Set your model as background. Search for a diamond paint model and use it as background in Excel: Page Layout=> Background and select the picture. It helps if it has a white frame. Also, you can use any photo.

2. Define your pallet as table. On first column add a header and then numbers starting from 0. Select the cells and transform to table with Ctrl+T. On Design=> Table Style, select None (no borders, no colors). Color each table cell with one of the colors matching your picture.

Tip: blank cell in Excel is assimilated to zero so you could use 0 for blank

3. Shrink rows and columns to create a gridline to fit the size of the diamond painting model. In this example I used 4 pixels. Do not include the rows containing the pallet or its column. Select the pallet and change the font to 4 (you have to type 4 and enter, it’s not in the dropdown list).

4. Zoom-in to 300% (in case you sized rows and columns to 4 pixels), and size the first column to align to the edge of the background picture. Go with the first picture that is covered correctly by gridline. You can delimit it with a thick border.

Now, shrink the pallet’s rows as much as you can still see the numbers.

Note: Remember the zoom you used in case you need to zoom in or out to check your work!

5. Lock the pallet on top. Select the first row beneath the pallet and View=> Freeze panes. It will keep your pallet visible since your chosen area is way below.

Now you are ready to diamond paint! It will look something like this:

For the VBA part you need one more thing to make sure any picture can be accommodated: mark the first cell in the area you are “painting”.

Select a cell close to the pallet (let’s say C1) and name it StartCell. Here type the reference of the first cell in the area you will paint (case insensitive).

6. Add the magic button. Open VBA editor (alt+F11) and Insert=> Module and copy the following code:

  1. Option Explicit
  2. Sub SetColor()
  3.     Dim rng As Range, cl As Range
  4.     Dim dColor As New Dictionary
  5.     Dim diamond As Boolean
  6. ' needs reference to Microsoft Scripting Runtime  
  8.     ActiveSheet.Unprotect
  9.     Set dColor = GetColorsDictionary
  10.     Set rng = Range("B13").CurrentRegion
  11.     If MsgBox("If you want DIAMOND like picture, select Yes, and for plain color select No." & vbCr & _
  12.             "Please note that diamond takes longer time and the color is revealed only when ready", vbYesNo + vbInformation) = vbYes Then diamond = True
  13.     For Each cl In rng
  14.         If dColor.Exists(cl.Value) Then
  15.             If diamond Then
  16.                 Application.ScreenUpdating = False
  17.                 With cl.Interior
  18.                     .Pattern = xlPatternRectangularGradient
  19.                     .Gradient.RectangleLeft = 0.5
  20.                     .Gradient.RectangleRight = 0.5
  21.                     .Gradient.RectangleTop = 0.5
  22.                     .Gradient.RectangleBottom = 0.5
  23.                     .Gradient.ColorStops.Clear
  24.                 End With
  25.                 With cl.Interior.Gradient.ColorStops.Add(0)
  26.                     .Color = 16777215
  27.                     .TintAndShade = 0
  28.                 End With
  29.                 With cl.Interior.Gradient.ColorStops.Add(1)
  30.                     .Color = dColor(cl.Value)
  31.                     .TintAndShade = 0
  32.                 End With
  33.                 Application.ScreenUpdating = True
  34.             Else
  35.                 cl.Interior.Color = dColor(cl.Value)
  36.             End If
  37.             cl.Font.Color = dColor(cl.Value)
  39.         End If
  40.     Next cl
  41.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
  42. End Sub
  43. Function GetColorsDictionary()
  44.     Dim i, tbl As ListObject
  45.     Dim rslt As New Dictionary
  47.     Set tbl = Sheets(1).ListObjects(1)
  48.     For i = 1 To tbl.DataBodyRange.Rows.Count
  49.         If Not rslt.Exists(tbl.DataBodyRange(i, 1).Value) Then _
  50.             rslt.Add tbl.DataBodyRange(i, 1).Value, tbl.DataBodyRange(i, 1).Interior.Color
  51.     Next i
  53.     Set GetColorsDictionary = rslt
  54. End Function

Add a button close to pallet and assign it the SetColor macro.

7. How to “paint”. Either type the color code from the pallet or copy paste the cell containing the code. While you fill in areas, you might see that the color on the pallet doesn’t match the picture. You can change the color on the palet and click on the button.

Note: every time you click the button, the sheet is protected. If you want to make changes, right-click on the sheet’s tab and select Unprotect.

From time to time, you can remove background (Page Layout menu) to see how it will look like. When filling in, remember to keep the same zoom you used to define gridline.

At the end, go to View and uncheck Gridlines, Headings, Formula Bar.

The macro allows to fill in either with plain color or gradient to mimic diamonds. First picture shows a plain color filling.

And this is how it looks with gradient filling:

Hope you enjoy it! If you want to start with this example, download the xlsx file (no macros) and add the VBA part yourself: DiamondPaintingExcel. You can use the same file to load other background picture.

Add a Comment

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.