Help with vba Columns and rows

Problem Statement:
Check column by column to see if Column(x) Row4 is Interior Color is Gray color RGB(220, 230, 241)
 If YES
Check all rows in Column(x) for content
If there is content, copy the content to Column(x), Row 2

Non Duplicates...
Check to see if the currently read contents are the same as the previously read contents
If they are not the same (No Duplicates)
      Write the contents to Cell Column (x), Row 2

excel vba check column for value
excel vba check column for duplicates

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Example using the screen shot in the document…
1)      Column “H” Row “4” contains the characters “CT_001” in a cell that has a gray background RGB(220,230,241)
2)      Check (read) the next row in Column “H”. It contains the characters “No”.
3)      Write the Characters “No” into a “read” variable.
4)      Write that variable to Column “H” Row “2”
5)      Read the next row. In this case “No Response Data Found”
6)      Check to see if the characters are equal to the “read” variable.
7)      If they are not write the characters to Column “H” Row “2”
8)      Move the characters “No Response Data Found” to the ‘Read” variable ( want to ensure duplicates do not get written.
9)      In this case Column “H” Row “2” will now contain the Characters “No” and “No Response Data Found”
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Code so far…
Sub FindGray

Dim col As Range, rg As Range
    Application.ScreenUpdating = False
    Set rg = ActiveSheet.UsedRange

If rg.Column <> 1 Then Range(Cells(1, 1), Cells(1, rg.Column - 1)).EntireColumn.Hidden = True
Range(Cells(1, rg.Column + rg.Columns.Count), Cells(1, ActiveSheet.Columns.Count)).EntireColumn.Hidden = True

For Each col In ActiveSheet.UsedRange.Columns
    If col.EntireColumn.Cells(4, 1).Interior.Color <> RGB(220, 230, 241) Then _ 
Next

End Sub

Open in new window

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Any help I can get with this would be greatly appreciated.
Please let me if you need more details or information.
Thanks in advance.

Please see the attached word file for problem re-statement and screenshot examples. Your help with this would be greatly appreciated.

Thanks in advance.
EE-Aggregate.docx
tesla764Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

hnasrCommented:
Upload a sheet with this issue. Show the results expected in the sheet.
0
tesla764Author Commented:
Please see attached file "EE-Aggregate.docx'.
0
Martin LissOlder than dirtCommented:
I'm not sure I can help but if I were to try I'd need your workbook.
0
FaustulusCommented:
Hello tesla764,
The code in the attached workbook does what your task describes - for better or for worse. Run the Sub Main to see the result. In order to adapt this code to your own workbook you may need to assign different values to the enums at the top of the code.
    Private Enum Nws                ' Worksheet parameters
        NwsSum = 2                  ' Row to show the summary in
        NwsTest = 4                 ' Test row
        NwsFirstDataRow             ' First row to collect data from
    End Enum
The FirstDataRow is the first row following NwsTest, i.e. row 5. If you need this to be another value just assign the value as you see it done for the other enumerations.
EXX-130830-Column-Summary.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
tesla764Author Commented:
Thank You. I have incorporated this into my program and with some adaptation this works very well. Thanks again for all your help.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.