colour interactive map based on data

Hi all,

I created a dashboard with a map of Japan that automatically visualises trends based on the data metric selected. Though, I want to keep all prefectures/provinces coloured 'black' with a white outline if there is NO data available. As an example, for the population data all prefectures have data available and should does be coloured accordingly, though, products aren't sold in all of them, thus, only the ones where data is available should be coloured. Currently it would colour them in the lightest colour (based on the legend defined)...

This is the code I am using:

Sub UpdateJapanColorScale()

' Update the RGB values and the colors of the legend after changing the color scale on worksheet [control]

Dim i As Integer
Dim rngJapan_MapValueToColor As Range
Dim rngColorScales As Range
Dim rngColorScaleSelection As Range
Dim rngLegend As Range
Dim myCell As Range

    ' Initialize
    
    Application.ScreenUpdating = False
    
    If Range("Selected_View").Value = 1 Then
    
        Set rngJapan_MapValueToColor = Range("Japan_MapValueToColor").Offset(0, 1).Resize(Range("Japan_MapValueToColor").Rows.Count, 1)
        Set rngColorScales = Range("Japan_myColorScales")
        Set rngColorScaleSelection = Range("Japan_myColorScaleSelection")
        Set rngLegend = Range("Japan_myLegend")
    
    ' Loop through the defined color scale and write the RGB values to the [control] sheet / format the legend cells on the map
    
    For i = 1 To rngJapan_MapValueToColor.Rows.Count
        rngJapan_MapValueToColor(i, 1) = rngColorScales(i, rngColorScaleSelection.Value).Interior.Color
        rngLegend(i, 1).Interior.Color = rngColorScales(i, rngColorScaleSelection.Value).Interior.Color
    Next i
    
    For Each myCell In Range("Japan_MapNameToShape").Columns(1).Cells
        CheckColor Range(myCell.Value), "Japan_MapNameToShape", "Japan_MapValueToColor"
    Next myCell
    
    Set rngJapan_MapValueToColor = Nothing
    Set rngColorScales = Nothing
    Set rngColorScaleSelection = Nothing
    Set rngLegend = Nothing
    Application.ScreenUpdating = True
       
    End If
    
    If Range("Selected_View").Value = 2 Then
    
        Set rngJapan_MapValueToColor = Range("Japan_MapValueToColor").Offset(0, 1).Resize(Range("Japan_MapValueToColor").Rows.Count, 1)
        Set rngColorScales = Range("JapanVAR_myColorScales")
        Set rngLegend = Range("Japan_myLegend")
    
    ' Loop through the defined color scale and write the RGB values to the [control] sheet / format the legend cells on the map
    
    For i = 1 To rngJapan_MapValueToColor.Rows.Count
        rngJapan_MapValueToColor(i, 1) = rngColorScales(i, 1).Interior.Color
        rngLegend(i, 1).Interior.Color = rngColorScales(i, 1).Interior.Color
    Next i

    ' Update the map to apply the new color to the choropleth map
    
    For Each myCell In Range("Japan_MapNameToShape").Columns(1).Cells
        CheckColor Range(myCell.Value), "Japan_MapNameToShape", "Japan_MapValueToColor"
    Next myCell
    
    ' Clean Up
    Set rngJapan_MapValueToColor = Nothing
    Set rngColorScales = Nothing
    Set rngLegend = Nothing
    Application.ScreenUpdating = True

End If
End Sub

I would assume this could be fixed with a 'simple' If statement somewhere in between the lines of code?

japan map forum.PNG