Periodic table with color code

Edit 2:

dipolar = {327, 413, 4135, 4372, 2715, 0, 11907, 7026, 24700, 25100, 
    21017, 12593, 4128, 0, 29, 200, 2242, 1509, 831, 74, 0, 7446, 
    4473, 15893, 16250, 13359, 8196, 2703, 0, 252,
    223, 0, 471, 96, 0, 6800, 9720, 9936, 4496, 280, 0, 32, 0, 2592, 
    2637, 1176, 0, 133, 0, 317, 65, 0, 4655, 6848, 6920, 3121, 197, 0,
     23, 0, 1881, 1881, 840, 0, 85, 0, 128, 162, 258, 3455, 2450, 
    4952, 3705, 0, 108, 0, 13, 0, 1096, 1148, 508, 0, 39, 0, 65, 85, 
    18, 1872, 1373, 2010, 2122, 1467, 64, 0, 8, 0, 674, 711, 320, 0, 
    23, 0, 3, 0, 279, 289, 142, 0, 7, 0, 1, 0, 126, 144, 76, 0, 1, 0};
minMax = MinMax@((dipolar)^(1/3)) // N;
data = Delete[Join @@ Table[{i, j}, {j, 10}, {i, 1, 18}], 
   Join @@ {List /@ Range[2], List /@ Range[18, 20], 
     List /@ Range[36, 54], List /@ Range[57, 57], 
     List /@ Range[75, 75], List /@ Range[129, 138], 
     List /@ Range[147, 156], List /@ Range[164, 179]}];
data2 = Flatten /@ Partition[Riffle[(dipolar)^(1/3), data], 2];

Legended[Graphics[{EdgeForm[{Black}], 
     ColorData["DarkRainbow"][Rescale[First[#], minMax]], 
     Rectangle[Rest[#]], Black, 
     Text[First[#]^3, Rest[#] + {0.5, 0.5}]  } & /@ data2], 
 BarLegend[{"DarkRainbow", minMax}, 
  Ticks -> {{0, 0}, {10, 1000}, {17.09975946676697`, 
     5000}, {21.54434690031884`, 10000}, {29.24017738212866`, 
     25000}}]]

Edit: Just replace dipolar with the original data and change $\{0,1\}$ with min and max of dipolar data..

dipolar = RandomReal[1, 118];

data = Delete[Join @@ Table[{i, j}, {j, 10}, {i, 1, 18}], 
   Join @@ {List /@ Range[2], List /@ Range[18, 20], 
     List /@ Range[36, 54], List /@ Range[57, 57], 
     List /@ Range[75, 75], List /@ Range[129, 138], 
     List /@ Range[147, 156], List /@ Range[164, 179]}];

data2 = Flatten /@ Partition[Riffle[dipolar, data], 2];

Legended[Graphics[{EdgeForm[{Black}], 
     ColorData["ThermometerColors"][Rescale[First[#], {0, 1}]], 
     Rectangle[Rest[#]]} & /@ data2], 
 BarLegend[{"ThermometerColors", {0, 1}}]]

Original answer:

Here is starting point. Now you need to paint each individual square with the dipolar data..

data = Delete[Join @@ Table[{i, j}, {j, 10}, {i, 1, 18}], 
   Join @@ {List /@ Range[2], List /@ Range[18, 20], 
     List /@ Range[36, 54], List /@ Range[57, 57], 
     List /@ Range[75, 75], List /@ Range[129, 138], 
     List /@ Range[147, 156], List /@ Range[164, 179]}];
Graphics[Rectangle[#] & /@ data]

where I used the list dipolar from Okkes's answer

dipolar2 = Flatten[Reverse @ 
   FoldPairList[TakeDrop, dipolar, {15, 15, 17, 17, 18, 18, 8, 8, 2}]]

and ColorData["Atoms", "Panel"] modified to remove Eventhandlers and to replace abbreviations for some elements to match the table in OP:

panel = Replace[ColorData["Atoms", "Panel"][[1, 1]] /. 
   EventHandler -> (# &), {"Lv" -> "Uuh", "Ts" -> "Uus", "Og" -> "Uuo", 
  "Nh" -> "Uut", "Fl" -> "Uuq", "Mc" -> "Uup"}, ∞]  ; 

with color function "Rainbow" (with purple tones clippped):

ClearAll[dipF, cF, reColorF] 
elements =  Cases[panel, Style[s_String, ___] :> s,  ∞];
dipF = # /. Dispatch[Thread[elements -> dipolar2]] &;
cF = ColorData["Rainbow"][Clip[Rescale[#^(1/3), 
    MinMax[(dipF /@ elements)^(1/3)]], {1/10, ∞}]] & ; 
reColorF[highlighted_: {}] := # /. {_RGBColor, {r_Rectangle, 
       Inset[Style[a_, b___], c___]}} :> 
  {EdgeForm[a /. {Alternatives @@ highlighted -> {Opacity[1], Magenta, 
           Thickness[.004]}, _ -> None}], cF[dipF @ a], 
  {r, Inset[Style[Column[{Style[a, White, FontSize -> Scaled[.02]], 
           Style[dipF@a, FontSize -> Scaled[.015], FontColor -> White]}, 
           Alignment -> Center, Spacings -> .15], b], c]}} &;

lgnd = BarLegend[{cF, {0, 25000}}, "TickSide" -> Left, LegendMarkerSize -> {50, 200}];
legend = RawBoxes @ Replace[ToBoxes[lgnd], Rule[FrameTicks, _] :> 
    Rule[FrameTicks, False], ∞];  
highlighted = {"H", "He", "Li", "Na", "K", "Rb", "Cs", "Ca", "Sr", 
   "Cr", "Dy", "Er", "Yb"} ;

Legended[Show[reColorF[highlighted]@panel  , ImageSize -> 700], legend]

the picture above