Code for Darken RGB

[Dossfm0q]

Greetings
Below Code for Lighten RGB How get Darken RGB?

[B]Sub lightenRGB()[/B]


    Dim I As Integer, Rng As Range
    Dim R As Byte, G As Byte, B As Byte
    Set Rng = Selection
    With Rng.Cells(1).Interior
    R = .Color Mod 256
    G = .Color \ 256 Mod 256
    B = .Color \ (CLng(256) * 256)
        End With
    For I = 2 To Rng.Cells.Count
        With Rng.Cells(I).Interior
        .Color = RGB(R + (255 - R) * (I - 1) / (Rng.Cells.Count - 1), G + (255 - G) * (I - 1) / (Rng.Cells.Count - 1), B + (255 - B) * (I - 1) / (Rng.Cells.Count - 1))
            End With
        Next I
        
    End Sub

THX

 

[footoo]

Sub DarkenTint()
Dim i%
Selection.Interior.Color = Selection(1).Interior.Color
For i = 2 To Selection.Count
    Selection(i).Interior.TintAndShade = Selection(i).Interior.TintAndShade - (i - 1) / Selection.Count
Next
End Sub

 

[Macropod]

Here's a different approach:

Sub Demo()
Dim StrCMYK As String, StrRGB As String
Dim i As Long, R As Long, G As Long, B As Long
Dim C As Single, M As Single, Y As Single, K As Single
With Selection
  For i = 1 To .Cells.Count
    With .Cells(i).Interior
      R = .Color \ 256 ^ 0 Mod 256
      G = .Color \ 256 ^ 1 Mod 256
      B = .Color \ 256 ^ 2 Mod 256
      StrCMYK = RGBtoCMYK(R, G, B)
      C = Split(StrCMYK, vbTab)(0)
      M = Split(StrCMYK, vbTab)(1)
      Y = Split(StrCMYK, vbTab)(2)
      K = Split(StrCMYK, vbTab)(3)
      'For darkening by a percentage, use:
      'K = K * 1.1
      'For darkening by a set amount, use:
      K = K + 0.1
      If K > 1 Then K = 1
      StrRGB = CMYKtoRGB(C, M, Y, K)
      R = Split(StrRGB, vbTab)(0)
      G = Split(StrRGB, vbTab)(1)
      B = Split(StrRGB, vbTab)(2)
      .Color = RGB(R, G, B)
    End With
  Next
End With
End Sub

Function RGBtoCMYK(R As Long, G As Long, B As Long) As String
Dim C As Single, M As Single, Y As Single, K As Single
C = 1 - (R / 255)
M = 1 - (G / 255)
Y = 1 - (B / 255)
K = 1
If C < K Then K = C
If M < K Then K = M
If Y < K Then K = Y
If K = 1 Then
  C = 0
  M = 0
  Y = 0
Else
  C = (C - K) / (1 - K)
  M = (M - K) / (1 - K)
  Y = (Y - K) / (1 - K)
End If
RGBtoCMYK = C & vbTab & M & vbTab & Y & vbTab & K
End Function

Function CMYKtoRGB(C As Single, M As Single, Y As Single, K As Single) As String
Dim R As Long, G As Long, B As Long
C = (C * (1 - K) + K)
M = (M * (1 - K) + K)
Y = (Y * (1 - K) + K)
R = (1 - C) * 255
G = (1 - M) * 255
B = (1 - Y) * 255
CMYKtoRGB = R & vbTab & G & vbTab & B
End Function

The code takes the existing RGB values, does an RGB to CMYK conversion, adjusts the K (black) value, then employs a CMYK to RGB conversion to get the new RGB values. Note the comments in the code for darkening by a percentage or fixed amount. To change the amount of darkening, simply change the value following the decimal point in:
K = K * 1.1
or:
K = K + 0.1
as appropriate.

 

[footoo]

The code takes the existing RGB values, does an RGB to CMYK conversion, adjusts the K (black) value, then employs a CMYK to RGB conversion to get the new RGB values. .

Based upon the code in post #1 , I don't think that is what's required.
The OP's code takes the color of the first cell in the selection then progressively lightens that color in each cell until the last cell has no color.

 

[Macropod]

Either way, the principle remains the same - the only difference is that, instead of getting a new RGB from each cell, the last-returned RGB value is used. And, that being the case, having gotten the initial value and done a CMYK conversion, all that's really needed from then is adjustments to the K value and a CMYK to RGB conversion to get the new RGB values for each cell. Hence, simply change the Demo sub to:

Sub Demo()
Dim StrCMYK As String, StrRGB As String
Dim i As Long, R As Long, G As Long, B As Long
Dim C As Single, M As Single, Y As Single, K As Single
With Selection
  With .Cells(1).Interior
    R = .Color \ 256 ^ 0 Mod 256
    G = .Color \ 256 ^ 1 Mod 256
    B = .Color \ 256 ^ 2 Mod 256
    StrCMYK = RGBtoCMYK(R, G, B)
    C = Split(StrCMYK, vbTab)(0)
    M = Split(StrCMYK, vbTab)(1)
    Y = Split(StrCMYK, vbTab)(2)
    K = Split(StrCMYK, vbTab)(3)
  End With
  For i = 2 To .Cells.Count
    With .Cells(i).Interior
      'For darkening by a percentage, use:
      'K = K * 1.1
      'For darkening by a set amount, use:
      K = K + 0.1
      If K > 1 Then K = 1
      StrRGB = CMYKtoRGB(C, M, Y, K)
      R = Split(StrRGB, vbTab)(0)
      G = Split(StrRGB, vbTab)(1)
      B = Split(StrRGB, vbTab)(2)
      .Color = RGB(R, G, B)
    End With
  Next
End With
End Sub

 

[footoo]

The code per post #2 produces colors that match the progressive colors per the standard color palette.
The code per post #3 (adjusted per post #5 ) does not.
The OP needs to check which one is suitable for his needs.

 

[Macropod]

The OP's own code doesn't produce colours that match the progressive colours per the standard colour palette, either...
That said, whether my code will match the progressive colours of the standard colour palette might depend on which darkening method is applied and what the darken factor on each iteration might be.

 

[footoo]

whether my code will match the progressive colours of the standard colour palette might depend on which darkening method is applied and what the darken factor on each iteration might be.

That said, if the requirement is for colors that progress in accordance with the progression of the standard color palette, then the code per post #2 is appropriate

The OP's own code doesn't produce colours that match the progressive colours per the standard colour palette, either...

Based on several test runs, it produces colors that seem to match the standard progression.

 

[Dossfm0q]

Much Thanks for respond

But RGBtoCMYK(R, G, B) gives msgbox Function not Defined

Thank again

 

[Dossfm0q]

Thank You All I Think Below What I Need

Sub Darken_RGB()


Dim i As Integer, Rng As Range
Dim R As Byte, G As Byte, B As Byte
Set Rng = Selection
With Rng.Cells(1).Interior
R = .Color Mod 256
G = (.Color \ 256) Mod 256
B = (.Color \ (CLng(256) * 256))
C = Rng.Cells.Count
End With
For i = 2 To C
With Rng.Cells(i)


.Interior.Color = RGB((R - (R - 0) * (i + 1) / (C + 1)), _
                      (G - (G - 0) * (i + 1) / (C + 1)), _
                      (B - (B - 0) * (i + 1) / (C + 1)))


End With
Next i
End Sub