Populate a 2-column list based on highlighted cells

[Pergo]

Hey all,

Was wondering if I could get some help with a Macro code that will fill out a 2-column list based off of highlighted cells.

Example:

On one sheet:

John 1A (2A) 3A 4A
Mike 1A 2A 3A 4A
Kate 1A 2A (3A) (4A)

( ) means the cell is highlighted a specific color, lets say purple.

Once I run the macro, it will fill out a list on another sheet based off of who has highlighted cells.

Result:

John 2A
Kate 3A
Kate 4A

Any help with this would be much appreciated, I suck at VB... it takes me hours of fiddling.

Thanks!!!

[StephenR]

Can you post a workbook? Are the cells coloured from conditional formatting?

[Pergo]

Can you post a workbook? Are the cells coloured from conditional formatting?

All highlighted cells will be manually colored.

Attached is the workbook. Look to tab "9513" for the reference and "Grand Slam" tab to fill out. I already filled out the GrandSlam tab with what the result would look like if the macro would work and have been ran like I desire. Let me know if you have any other questions!!!

Thanks!

[Pergo]

added the file

[StephenR]

I see some purple cells in the first sheet, but I don't see what goes in the second sheet.

[Pergo]

I actually think I have it figured out, but the only road block i'm getting now is being able to assign a value to a cell based on another cell's value. I don't think I'm defining my variables as the right class...

Sub Populate()

Dim Cell As Range

Dim Src As Worksheet
Dim Dst As Worksheet
Dim Corp As String
Dim SrcRng As Range
Dim NextTech As Range
Dim NextJob As Range
Dim Tech As String
Dim Job As String

Set Dst = ThisWorkbook.ActiveSheet
Corp = Dst.Range("BC1")

Set SrcRng = Src.Range("I12:BF251")
Set RngEnd = Wks.Cells(Rows.Count, TotalRng.Column).End(xlUp)
Set SrcRng = IIf(RngEnd.row > TotalRng.row, TotalRng, Wks.Range(TotalRng, RngEnd))
'
'
'
For Each Cell In SrcRng
If Cell.Interior.Color = RGB(112, 48, 160) Then
NextJob = Cell
NextTech = Cell.Offset(0, -60)
Set NextJob = NextJob.Offset(1, 0)
Set NextTech = NextTech.Offset(1, 0)
End If
Next Cell

basically,

1) Scan range on sheet 1 for purple cells.
2) When it finds a purple cell, it put's its value on column1 of sheet 2.
a) It also takes the cell 60 columns to the left of the purple cell and puts it's value on column 2 of sheet 2.

3) Then moves down to the next row on sheet 2 and continues to look for the remaining purple cells in sheet 1.

Let me know if you need anything else!

[Pergo]

I actually almost have this function sorted out, I'm just having a problem with the Rows function within this script. I will mark this solved and make another thread!