automatically input number in cell based on cell color

[BDBoyd]

My worksheet has over 100 rows. Each of these rows has 2 or more connected cells that are colored. I would like to automatically enter a 1 in the leftmost cell once it is colored and a 2 in the rightmost cell that is colored. This could be independent of the cell color

 

[Joe4]

Welcome to the Board!

Native Excel formulas can only run against values. They cannot run against formatting features, like color.

How was the color added? Manually, by Conditional Formatting, or by VBA?
If by Conditional Formatting, you may be able to use the same logic that triggered the Conditional Formatting to enter the values you desire.
Otherwise, this will almost certainly require VBA.

What is the goal/purpose of this exercise (what is it being used for)? I ask because if we have a better idea of the "big picture" regarding what you are trying to accomplish, we may be able to provide better alternatives.
Will these colored cells have values in them, or will they always be blank?
What is the maximum column that may be colored? Excel has up to 16384 columns, and if we have to check every single one for over 100 rows, it will slow your code down. So the more we can limit it, the faster the code will be.

 

[BDBoyd]

Joe4,

The purpose is a calendar of sorts. Durations are manually highlighted. I want to put 1 in the first highlighted cell and a 2 in the last. The purpose of the numbers is so that i can do other things with the rows. If i can identify the highlighted cells another way i am open to it. I can attach o file if you like.

 

[Joe4]

OK. Please answer the other questions I asked, namely:

- Will these colored cells have values in them, or will they always be blank?

- What is the maximum column that may be colored?

Also, when populated them with a 1 or 2, you mean for every row that is colored, right (so, every row what has colored cells will have a 1 and 2 added somewhere)?

Is it also possible that only one single cell is colored?
If so, then does it get just a 1, or a 1 and a 2?

Note you cannot upload files to this site. But there are tools you can use to post screen images, if you feel that would be helpful. They are listed in Section B of this link here: http://www.mrexcel.com/forum/board-a...forum-use.html. Also, there is a Test Here forum on this board that you can use to test out these tools to make sure they are working correctly before using them in your question.

 

[BDBoyd]

Cells will always be blank.
columns are less than 100
there will always be at leas t 2 cells colored ( never a need for only a 1).
Yes, every row will have a 1 or a 2

 

[Joe4]

Try this:

Sub MyAddNumbers()

    Dim maxCol As Long
    Dim maxRow As Long
    Dim r As Long
    Dim cs As Long
    Dim ce As Long
    
    Application.ScreenUpdating = False
    
'   Set maximum number of rows and columns to search
    maxCol = 100
    maxRow = 100

'   Loop through all rows
    For r = 1 To maxRow
'       Find first colored column in row
        For cs = 1 To maxCol
            If Cells(r, cs).Interior.Color <> 16777215 Then
                Cells(r, cs) = 1
                Exit For
            End If
        Next cs
'       Find last colored column in row
        For ce = maxCol To 1 Step -1
            If Cells(r, ce).Interior.Color <> 16777215 Then
                Cells(r, ce) = 2
                Exit For
            End If
        Next ce
    Next r

    Application.ScreenUpdating = True
    
    MsgBox "Macro complete"
    
End Sub

You can change the values of maxCol and maxRow to suit.

 

[BDBoyd]

works great, thank you!

 

[Joe4]

You are welcome.

 

[BDBoyd]

one more question. Can we define a range for this so it doesn't apply to the whole worksheet? For example M17:CC100?

 

[Joe4]

Try this:

Sub MyAddNumbers()

    Dim startRow As Long
    Dim startCol As Long
    Dim endCol As Long
    Dim endRow As Long
    Dim r As Long
    Dim cs As Long
    Dim ce As Long
    
    Application.ScreenUpdating = False
    
'   Set starting and ending values
[COLOR=#0000ff]    startRow = 17
    endRow = 100
    startCol = 13
    endCol = 55[/COLOR]

'   Loop through all rows
    For r = startRow To endRow
'       Find first colored column in row
        For cs = startCol To endCol
            If Cells(r, cs).Interior.Color <> 16777215 Then
                Cells(r, cs) = 1
                Exit For
            End If
        Next cs
'       Find last colored column in row
        For ce = endCol To startCol Step -1
            If Cells(r, ce).Interior.Color <> 16777215 Then
                Cells(r, ce) = 2
                Exit For
            End If
        Next ce
    Next r

    Application.ScreenUpdating = True
    
    MsgBox "Macro complete"
    
End Sub

Note the blue part of the code where you can define which rows/columns to apply this to. Change as needed.