Peter,

The routine places a value in the cells of column D (under the shape). If I
transfer those
numbers to a different sheet, what would the routine be if using those
numbers
rather than the RGB values in columns A,B & C? ...the numbers would be in
column F of this new sheet

Thanks

ADK

"Peter T" <peter_t@discussions> wrote in message
news:(E-Mail Removed)...
> "ADK" wrote
>> We are currently using Excel 2000
>
> Er, OK.
>
> As it happens the routine I posted was written in Excell 2000.
>
> Not sure what you are trying to convey.
>
> Regards,
> Peter T
>
>



"Peter T" <peter_t@discussions> wrote in message
news:%(E-Mail Removed)...
> In pre-XL2007 you are limited to 56 unique palette colours which can be
> customized, hence why I
> asked how many unique colours you might require.
> There's no limit to unique RGB's in shapes on a sheet (subject
> resources).
> Following adds shapes, if don't already exist, sized to cells in the
> fourth
> column and
> fills with the RGB.
>
> Try "Test" on a new sheet
>
> Sub Test()
>
> With Range("A2:c500")
> .Formula = "=INT(RAND()*255)"
> .Value = .Value
> End With
>
> MultiRGBs
> End Sub
>
> Sub MultiRGBs()
> Dim i As Long
> Dim nCol As Long
> Dim sName As String
> Dim vArr3, vArr1
> Dim rng As Range, cell As Range
> Dim shp As Shape
>
> 'part1
> 'write the long RGB colour values in Col-D
>
> ' assumes first red-value is in A2, with green & blue in B2:C2
> Set rng = Range("A2")
> Set rng = Range(rng, _
> Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column))
>
> vArr3 = rng.Resize(, 3).Value
> ReDim vArr1(1 To UBound(vArr3), 1 To 1)
>
> For i = 1 To UBound(vArr3)
> vArr1(i, 1) = RGB(vArr3(i, 1), vArr3(i, 2), vArr3(i, 3))
> Next
> rng.Offset(, 3).Value = vArr1
>
>
>
> ' part 2
> ' if shape name clr&cell-ref doesn't exist add it
> ' fill the RGB with the long colour value in the cell in col-D
>
> 'ActiveSheet.Rectangles.Delete 'start with fresh shapes
>
> 'Application.ScreenUpdating = False
>
> ' Set rng = Range("A2")
> ' Set rng = Range(rng, _
> ' Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column))
>
> nCol = rng(1).Column + 3
>
> With ActiveSheet.Shapes
> For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1
> Set cell = Cells(i, nCol)
> sName = "clr" & cell.Address(0, 0)
>
> Set shp = Nothing
> On Error Resume Next
> Set shp = .Item(sName)
> On Error GoTo 0
>
> If shp Is Nothing Then
> Set shp = .AddShape(1, cell.Left, cell.Top, _
> cell.Width, cell.Height)
> shp.Name = sName
> End If
>
> With shp.Fill.ForeColor
> If .RGB <> cell Then .RGB = cell
> End With
> Next
> End With
> Application.ScreenUpdating = True
>
> End Sub
>
>
> I separated the above into two parts for demo purposes.
>
> Instead of "part1" you could use this formula filled down.
> =(r + g*256 + b*256*256)
>
> A Worksheet change event could change the filled RGB colour if any r, G or
> B
> value changes (adapt the above into the change event).
>
> It's quite a bit more complicated but it's also possible to scatter UDF's
> in
> cells to be filled with unique RGB's (goes against UDF rules!).
>
> Regards,
> Peter T
>
>
>
> "ADK" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
>> What I would like to do is take the colors from AutoCAD (ACI) and create
>> a
>> layer color table with a color sample in a cell. There are 256 colors in
>> autocad so to answer your question, 256. I am working on converting
> AutoCAD
>> Color Index (ACI) into RGB numbers.
>>
>>
>> "Peter T" <peter_t@discussions> wrote in message
>> news:(E-Mail Removed)...
>> > ADK, how many unique colours do you envisage (envision) you will need
>> > in
>> > total in the workbook.
>> >
>> > Mike, the approach you suggested applies the 'nearest' RGB that already
>> > exists in the palette. IOW one of the existing palette colours will be
>> > applied, of which there are 46 in a default palette.
>> >
>> > Regards,
>> > Peter T
>> >
>> > "ADK" <(E-Mail Removed)> wrote in message
>> > news:(E-Mail Removed)...
>> >> A beginner at this vba stuff. Looking to color a cell based on RGB
> values
>> >>
>> >> Column A has the R numbers
>> >> Column B has the G numbers
>> >> Column C has the B numbers
>> >> Column D will be the where the cells fill color is based on the values
>> >> entered in columns A thru C. I'll have 256 rows ...each row will end
>> >> up
>> >> having a different fill color based on the values
>> >>
>> >> Example
>> >>
>> >> A1=255
>> >> B1=255
>> >> C1=0
>> >> D1={cell fill color would be yellow}
>> >>
>> >> A2=255
>> >> B2=191
>> >> C2=0
>> >> D2={cell fill color would be orange}
>> >>
>> >> Thanks in advance for your help!
>> >>
>> >> ADK
>> >>
>> >>
>> >
>> >
>>
>>
>
>

See my follow-up in your original thread.

Normally it's best to continue in the same thread, rather than starting a
new thread merely to continue the same topic. I only saw this message by
chance.

From the additional information you provided below it appears your
colour-values will be in col-F on some sheet, so in the new routine I posted
(in the original thread) change "G2" to "F2" or whatever the first cell is.

Regards,
Peter T

"ADK" <(E-Mail Removed)> wrote in message
news:%(E-Mail Removed)...
> Peter,
>
> The routine places a value in the cells of column D (under the shape). If
I
> transfer those
> numbers to a different sheet, what would the routine be if using those
> numbers
> rather than the RGB values in columns A,B & C? ...the numbers would be in
> column F of this new sheet
>
> Thanks
>
> ADK
>
> "Peter T" <peter_t@discussions> wrote in message
> news:(E-Mail Removed)...
> > "ADK" wrote
> >> We are currently using Excel 2000
> >
> > Er, OK.
> >
> > As it happens the routine I posted was written in Excell 2000.
> >
> > Not sure what you are trying to convey.
> >
> > Regards,
> > Peter T
> >
> >
>
>
>
> "Peter T" <peter_t@discussions> wrote in message
> news:%(E-Mail Removed)...
> > In pre-XL2007 you are limited to 56 unique palette colours which can be
> > customized, hence why I
> > asked how many unique colours you might require.
> > There's no limit to unique RGB's in shapes on a sheet (subject
> > resources).
> > Following adds shapes, if don't already exist, sized to cells in the
> > fourth
> > column and
> > fills with the RGB.
> >
> > Try "Test" on a new sheet
> >
> > Sub Test()
> >
> > With Range("A2:c500")
> > .Formula = "=INT(RAND()*255)"
> > .Value = .Value
> > End With
> >
> > MultiRGBs
> > End Sub
> >
> > Sub MultiRGBs()
> > Dim i As Long
> > Dim nCol As Long
> > Dim sName As String
> > Dim vArr3, vArr1
> > Dim rng As Range, cell As Range
> > Dim shp As Shape
> >
> > 'part1
> > 'write the long RGB colour values in Col-D
> >
> > ' assumes first red-value is in A2, with green & blue in B2:C2
> > Set rng = Range("A2")
> > Set rng = Range(rng, _
> > Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column))
> >
> > vArr3 = rng.Resize(, 3).Value
> > ReDim vArr1(1 To UBound(vArr3), 1 To 1)
> >
> > For i = 1 To UBound(vArr3)
> > vArr1(i, 1) = RGB(vArr3(i, 1), vArr3(i, 2), vArr3(i, 3))
> > Next
> > rng.Offset(, 3).Value = vArr1
> >
> >
> >
> > ' part 2
> > ' if shape name clr&cell-ref doesn't exist add it
> > ' fill the RGB with the long colour value in the cell in col-D
> >
> > 'ActiveSheet.Rectangles.Delete 'start with fresh shapes
> >
> > 'Application.ScreenUpdating = False
> >
> > ' Set rng = Range("A2")
> > ' Set rng = Range(rng, _
> > ' Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column))
> >
> > nCol = rng(1).Column + 3
> >
> > With ActiveSheet.Shapes
> > For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1
> > Set cell = Cells(i, nCol)
> > sName = "clr" & cell.Address(0, 0)
> >
> > Set shp = Nothing
> > On Error Resume Next
> > Set shp = .Item(sName)
> > On Error GoTo 0
> >
> > If shp Is Nothing Then
> > Set shp = .AddShape(1, cell.Left, cell.Top, _
> > cell.Width, cell.Height)
> > shp.Name = sName
> > End If
> >
> > With shp.Fill.ForeColor
> > If .RGB <> cell Then .RGB = cell
> > End With
> > Next
> > End With
> > Application.ScreenUpdating = True
> >
> > End Sub
> >
> >
> > I separated the above into two parts for demo purposes.
> >
> > Instead of "part1" you could use this formula filled down.
> > =(r + g*256 + b*256*256)
> >
> > A Worksheet change event could change the filled RGB colour if any r, G
or
> > B
> > value changes (adapt the above into the change event).
> >
> > It's quite a bit more complicated but it's also possible to scatter
UDF's
> > in
> > cells to be filled with unique RGB's (goes against UDF rules!).
> >
> > Regards,
> > Peter T
> >
> >
> >
> > "ADK" <(E-Mail Removed)> wrote in message
> > news:(E-Mail Removed)...
> >> What I would like to do is take the colors from AutoCAD (ACI) and
create
> >> a
> >> layer color table with a color sample in a cell. There are 256 colors
in
> >> autocad so to answer your question, 256. I am working on converting
> > AutoCAD
> >> Color Index (ACI) into RGB numbers.
> >>
> >>
> >> "Peter T" <peter_t@discussions> wrote in message
> >> news:(E-Mail Removed)...
> >> > ADK, how many unique colours do you envisage (envision) you will need
> >> > in
> >> > total in the workbook.
> >> >
> >> > Mike, the approach you suggested applies the 'nearest' RGB that
already
> >> > exists in the palette. IOW one of the existing palette colours will
be
> >> > applied, of which there are 46 in a default palette.
> >> >
> >> > Regards,
> >> > Peter T
> >> >
> >> > "ADK" <(E-Mail Removed)> wrote in message
> >> > news:(E-Mail Removed)...
> >> >> A beginner at this vba stuff. Looking to color a cell based on RGB
> > values
> >> >>
> >> >> Column A has the R numbers
> >> >> Column B has the G numbers
> >> >> Column C has the B numbers
> >> >> Column D will be the where the cells fill color is based on the
values
> >> >> entered in columns A thru C. I'll have 256 rows ...each row will end
> >> >> up
> >> >> having a different fill color based on the values
> >> >>
> >> >> Example
> >> >>
> >> >> A1=255
> >> >> B1=255
> >> >> C1=0
> >> >> D1={cell fill color would be yellow}
> >> >>
> >> >> A2=255
> >> >> B2=191
> >> >> C2=0
> >> >> D2={cell fill color would be orange}
> >> >>
> >> >> Thanks in advance for your help!
> >> >>
> >> >> ADK
> >> >>
> >> >>
> >> >
> >> >
> >>
> >>
> >
> >
>
>

Thanks

"Peter T" <peter_t@discussions> wrote in message
news:(E-Mail Removed)...
> See my follow-up in your original thread.
>
> Normally it's best to continue in the same thread, rather than starting a
> new thread merely to continue the same topic. I only saw this message by
> chance.
>
> From the additional information you provided below it appears your
> colour-values will be in col-F on some sheet, so in the new routine I
> posted
> (in the original thread) change "G2" to "F2" or whatever the first cell
> is.
>
> Regards,
> Peter T
>
> "ADK" <(E-Mail Removed)> wrote in message
> news:%(E-Mail Removed)...
>> Peter,
>>
>> The routine places a value in the cells of column D (under the shape). If
> I
>> transfer those
>> numbers to a different sheet, what would the routine be if using those
>> numbers
>> rather than the RGB values in columns A,B & C? ...the numbers would be in
>> column F of this new sheet
>>
>> Thanks
>>
>> ADK
>>
>> "Peter T" <peter_t@discussions> wrote in message
>> news:(E-Mail Removed)...
>> > "ADK" wrote
>> >> We are currently using Excel 2000
>> >
>> > Er, OK.
>> >
>> > As it happens the routine I posted was written in Excell 2000.
>> >
>> > Not sure what you are trying to convey.
>> >
>> > Regards,
>> > Peter T
>> >
>> >
>>
>>
>>
>> "Peter T" <peter_t@discussions> wrote in message
>> news:%(E-Mail Removed)...
>> > In pre-XL2007 you are limited to 56 unique palette colours which can be
>> > customized, hence why I
>> > asked how many unique colours you might require.
>> > There's no limit to unique RGB's in shapes on a sheet (subject
>> > resources).
>> > Following adds shapes, if don't already exist, sized to cells in the
>> > fourth
>> > column and
>> > fills with the RGB.
>> >
>> > Try "Test" on a new sheet
>> >
>> > Sub Test()
>> >
>> > With Range("A2:c500")
>> > .Formula = "=INT(RAND()*255)"
>> > .Value = .Value
>> > End With
>> >
>> > MultiRGBs
>> > End Sub
>> >
>> > Sub MultiRGBs()
>> > Dim i As Long
>> > Dim nCol As Long
>> > Dim sName As String
>> > Dim vArr3, vArr1
>> > Dim rng As Range, cell As Range
>> > Dim shp As Shape
>> >
>> > 'part1
>> > 'write the long RGB colour values in Col-D
>> >
>> > ' assumes first red-value is in A2, with green & blue in B2:C2
>> > Set rng = Range("A2")
>> > Set rng = Range(rng, _
>> > Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column))
>> >
>> > vArr3 = rng.Resize(, 3).Value
>> > ReDim vArr1(1 To UBound(vArr3), 1 To 1)
>> >
>> > For i = 1 To UBound(vArr3)
>> > vArr1(i, 1) = RGB(vArr3(i, 1), vArr3(i, 2), vArr3(i, 3))
>> > Next
>> > rng.Offset(, 3).Value = vArr1
>> >
>> >
>> >
>> > ' part 2
>> > ' if shape name clr&cell-ref doesn't exist add it
>> > ' fill the RGB with the long colour value in the cell in col-D
>> >
>> > 'ActiveSheet.Rectangles.Delete 'start with fresh shapes
>> >
>> > 'Application.ScreenUpdating = False
>> >
>> > ' Set rng = Range("A2")
>> > ' Set rng = Range(rng, _
>> > ' Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column))
>> >
>> > nCol = rng(1).Column + 3
>> >
>> > With ActiveSheet.Shapes
>> > For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1
>> > Set cell = Cells(i, nCol)
>> > sName = "clr" & cell.Address(0, 0)
>> >
>> > Set shp = Nothing
>> > On Error Resume Next
>> > Set shp = .Item(sName)
>> > On Error GoTo 0
>> >
>> > If shp Is Nothing Then
>> > Set shp = .AddShape(1, cell.Left, cell.Top, _
>> > cell.Width, cell.Height)
>> > shp.Name = sName
>> > End If
>> >
>> > With shp.Fill.ForeColor
>> > If .RGB <> cell Then .RGB = cell
>> > End With
>> > Next
>> > End With
>> > Application.ScreenUpdating = True
>> >
>> > End Sub
>> >
>> >
>> > I separated the above into two parts for demo purposes.
>> >
>> > Instead of "part1" you could use this formula filled down.
>> > =(r + g*256 + b*256*256)
>> >
>> > A Worksheet change event could change the filled RGB colour if any r, G
> or
>> > B
>> > value changes (adapt the above into the change event).
>> >
>> > It's quite a bit more complicated but it's also possible to scatter
> UDF's
>> > in
>> > cells to be filled with unique RGB's (goes against UDF rules!).
>> >
>> > Regards,
>> > Peter T
>> >
>> >
>> >
>> > "ADK" <(E-Mail Removed)> wrote in message
>> > news:(E-Mail Removed)...
>> >> What I would like to do is take the colors from AutoCAD (ACI) and
> create
>> >> a
>> >> layer color table with a color sample in a cell. There are 256 colors
> in
>> >> autocad so to answer your question, 256. I am working on converting
>> > AutoCAD
>> >> Color Index (ACI) into RGB numbers.
>> >>
>> >>
>> >> "Peter T" <peter_t@discussions> wrote in message
>> >> news:(E-Mail Removed)...
>> >> > ADK, how many unique colours do you envisage (envision) you will
>> >> > need
>> >> > in
>> >> > total in the workbook.
>> >> >
>> >> > Mike, the approach you suggested applies the 'nearest' RGB that
> already
>> >> > exists in the palette. IOW one of the existing palette colours will
> be
>> >> > applied, of which there are 46 in a default palette.
>> >> >
>> >> > Regards,
>> >> > Peter T
>> >> >
>> >> > "ADK" <(E-Mail Removed)> wrote in message
>> >> > news:(E-Mail Removed)...
>> >> >> A beginner at this vba stuff. Looking to color a cell based on RGB
>> > values
>> >> >>
>> >> >> Column A has the R numbers
>> >> >> Column B has the G numbers
>> >> >> Column C has the B numbers
>> >> >> Column D will be the where the cells fill color is based on the
> values
>> >> >> entered in columns A thru C. I'll have 256 rows ...each row will
>> >> >> end
>> >> >> up
>> >> >> having a different fill color based on the values
>> >> >>
>> >> >> Example
>> >> >>
>> >> >> A1=255
>> >> >> B1=255
>> >> >> C1=0
>> >> >> D1={cell fill color would be yellow}
>> >> >>
>> >> >> A2=255
>> >> >> B2=191
>> >> >> C2=0
>> >> >> D2={cell fill color would be orange}
>> >> >>
>> >> >> Thanks in advance for your help!
>> >> >>
>> >> >> ADK
>> >> >>
>> >> >>
>> >> >
>> >> >
>> >>
>> >>
>> >
>> >
>>
>>
>
>