View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Need a little excel coding help

No, I was working with fill color, but I had assumed constants - Try changing

Sheets("Notes").Cells(myR + 1, 1).EntireRow. _
SpecialCells(xlCellTypeConstants).Interior.ColorIn dex _
= Target.Interior.ColorIndex

to

Sheets("Notes").Cells(myR + 1, 1).Resize(1,7).Interior.ColorIndex _
= Target.Interior.ColorIndex


HTH,
Bernie
MS Excel MVP


"hshayh0rn" wrote in message
...
Are you looking at font color or cell fill color? I am referring to cell fill
color not font color.

"Bernie Deitrick" wrote:

Is your coloring from conditional formatting? The color 'capture' worked in my testing, as long
as
column D (where you enter Fail) has the correct colorindex.

All hyperlinks have a specific style applied to them - you can change the default for the
workbook
by using Format / Style.... and selecting "Hyperlink" from the dropdown, and editing that
style's
font.

HTH,
Bernie
MS Excel MVP


"hshayh0rn" wrote in message
...
Also, the hyperlink is shrinking the font of the word fail from 9pt to 7pt.
Can we correct the size in the code too?

"Bernie Deitrick" wrote:

That was fairly inefficient code... try it like this (no need for looping). I'm not sure
where
your code added "column G" - if you are using another event this code will prevent that from
occuring - but this should handle the color issue, as well as the possibly blank cell in
column
A.

Private Sub Worksheet_Change(ByVal Target As range)
Dim i As Integer
Dim myR As Long

If Target.Cells.Count 1 Then Exit Sub
If Target.Column < 4 Then Exit Sub
If UCase(Target.Value) < "FAIL" Then Exit Sub

Application.EnableEvents = False
myR = Sheets("Notes").Cells(Rows.Count, 4).End(xlUp).Row
Target.EntireRow.Copy Sheets("Notes").Cells(myR + 1, 1).EntireRow
If Target.EntireRow.Cells(1, 1).Value = "" Then
Worksheets("Notes").range("A" & myR + 1).Value = _
Target.EntireRow.Cells(1, 1).End(xlUp).Value
Else
Worksheets("Notes").range("A" & myR + 1).Value = _
Target.EntireRow.Cells(1, 1).Value
End If
Sheets("Notes").Cells(myR + 1, 1).EntireRow. _
SpecialCells(xlCellTypeConstants).Interior.ColorIn dex _
= Target.Interior.ColorIndex


Adden = "Notes!H" & myR
ActiveSheet.Hyperlinks.Add Anchor:=Target, _
Address:="", SubAddress:=Adden, _
TextToDisplay:="Fail"
Application.EnableEvents = True
End Sub




HTH,
Bernie
MS Excel MVP


"hshayh0rn" wrote in message
...
I'm looking for someone who can expand on that I already have here.

http://www.microsoft.com/office/comm...286&sloc=en-us

I'm looking to take the above thread a little further. Right now based on a
value in a cell on sheet 1 the entire row is copied to sheet 2. The problem
is the copied row may have a blank value in column A. Column A has values at
the start of each list and then nothing until a new list is started. I need
the code that was detailed in the above link to look in column A upwards
until it finds a value and then use that value.

Also, the copied column is colored. However, when it's pasted into sheet 2
there is an addiitonal column at the end of the row and obviously that column
wouldn't have the same color as the rest of the row. I need the code to
determine the color of the row and make that column's cell the same color.
For example:

row 3 is copied to sheet 2. Column G is the added column on sheet 2 so we
need to color cell G3 the same color as the row we just copied.

Can anyone help me with this?