Loop to paste values to cells that fit specific criteria.

[Tyson 1932]

I'm having a heck of a time figuring this one out and haven't found exactly what I'm looking for in the threads. Any help is very much appeciated!
I am attempting to loop through the range("AN27:AP35") for each cell with the text "b" I want to copy it and paste it to the corresponding row in range("S27:AD35"), but only in a cell that is conditionally formatted to be shaded and if there isn't already a "b" in that column.

	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP
27																						b
28																						b
29																						b	b
30																						b	b
31																						b	b
32
33
34
35

The end result would ideally look something like this:

	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP
27			b																			b
28				b																		b
29					b	b																b	b
30							b	b														b	b
31									b	b												b	b
32
33
34
35

Thank you!

 

[kevin9999]

but only in a cell that is conditionally formatted to be shaded

What is the condition for the cell to be formatted?

 

[Tyson 1932]

What is the condition for the cell to be formatted?

Thanks for the reply!
For context, this is a scheduler for employees. “b” represents a specific job type to be assigned to the employee. Each row that’s shaded is an employees shift for the day between 8AM and 8PM (S27:AD27). In my example, the employee in the first row is scheduled 10 AM- 4PM, and so the cell is formatted to be shaded if it is within the range of their shift.

 

[kevin9999]

Could you provide the formula you use in the CF that causes the cells to be shaded? Excel has no native function that recognises a cell shaded by CF, but I'm thinking that the same logic could be used that you're currently using to shade the cells - along with an addition to look at columns AN:AO - to return a "b" in columns S:AD. It would be preferable if you could provide a sample of your sheet using the XL2BB add in, as that would show the Conditional Formatting rule being applied.

 

[Tyson 1932]

Yes, sorry I misunderstood. I tried to use the XL2BB add in, but when using the "Mini Sheet" function, excel freezes and crashes so I was only able to use the "Table Only" function.
The formula for conditional formatting is [ =AND(E$26>=$O27,$O27<>"",E$26<$P27) ]
This is what I have so far. I do not know how to search each column to ensure there is not already a "b" in the current column. Moreover, it seems inefficient to do it this way because I'll have to write multiple lines of code for each individual row (although, the number of rows is static and minimal so it won't be too bad).

The If statement I used seems to recognize the conditionally formatted cells

Sub populateShifts()
Dim rng As Range
Dim rngCell As Range
Dim pasteRng As Range
Dim tech1shiftCount As Integer

Set rng = Range("U27:AB35")
Set pasteRng = Range("AN27:AP35")

tech1shiftCount = Application.WorksheetFunction.CountIf(Range("AN27:AP27"), "=b")
Do While tech1shiftCount > 0
   For Each rngCell In Range("AN27:AN35")
        If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(166, 166, 166) And CountIf(Range(?????????"CURRENT COLUMN"???????), "=b") = 0 Then
            rngCell.Text = "b"
            tech1shiftCount = tech1shiftCount - 1
        End If
        
    Next
    
Loop

End Sub

 

[kevin9999]

Try the following on a copy of your worksheet (just change the sheet name to suit)

Option Explicit
Sub Tyson()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")           '<< Change to actual sheet name
    ws.Range("S27:AD35").ClearContents
    
    Dim i As Long, j As Long, k As Long, x As Long
    For i = 27 To 35
        k = WorksheetFunction.CountIf(ws.Range(ws.Cells(i, 40), ws.Cells(i, 42)), "b")
        If k > 0 Then
            x = 1
            For j = 21 To 30
                If WorksheetFunction.CountIf(ws.Columns(j), "b") = 0 _
                And ws.Cells(i, j).DisplayFormat.Interior.Color = RGB(166, 166, 166) Then
                    If x <= k Then
                        ws.Cells(i, j) = "b"
                    End If
                x = x + 1
                End If
            Next j
        End If
    Next i

Application.ScreenUpdating = False
End Sub

On a test sheet, it turned this:

Tyson.xlsm
	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP
27																						b
28																						b
29																						b	b
30																						b	b
31																						b	b
32
33
34
35
Sheet1

Into this:

Tyson.xlsm
	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP
27			b																			b
28				b																		b
29					b	b																b	b
30							b	b														b	b
31									b	b												b	b
32
33
34
35
Sheet1

 

[Tyson 1932]

Try the following on a copy of your worksheet (just change the sheet name to suit)

Option Explicit
Sub Tyson()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")           '<< Change to actual sheet name
    ws.Range("S27:AD35").ClearContents
   
    Dim i As Long, j As Long, k As Long, x As Long
    For i = 27 To 35
        k = WorksheetFunction.CountIf(ws.Range(ws.Cells(i, 40), ws.Cells(i, 42)), "b")
        If k > 0 Then
            x = 1
            For j = 21 To 30
                If WorksheetFunction.CountIf(ws.Columns(j), "b") = 0 _
                And ws.Cells(i, j).DisplayFormat.Interior.Color = RGB(166, 166, 166) Then
                    If x <= k Then
                        ws.Cells(i, j) = "b"
                    End If
                x = x + 1
                End If
            Next j
        End If
    Next i

Application.ScreenUpdating = False
End Sub

On a test sheet, it turned this:

Tyson.xlsm
	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP
27																						b
28																						b
29																						b	b
30																						b	b
31																						b	b
32
33
34
35
Sheet1

Into this:

Tyson.xlsm
	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP
27			b																			b
28				b																		b
29					b	b																b	b
30							b	b														b	b
31									b	b												b	b
32
33
34
35
Sheet1

That worked great! Thank you so much!!

 

[kevin9999]

Glad to help Tyson, and welcome to Mr Excel
Just change that last line to Application.ScreenUpdating = True