Macro to read cell contents and compare data

jrfoley3 · #1 07-06-2016, 09:10 AM

I have a phone data spreadsheet with 5K cols and 24K rows. I would like to create two macros.

First - to read data in each col and
1. if all of the data (alpha/numeric) is the same fill in the header cell green
2. if there are any blank cells (null) fill in the header yellow
3. if the data is different fill in the cells red

Second - run a macro that would tell me in the col that finds differences in data (#3 above), what percent of the cells are different.

This is above my current talent level so any help would be greatly appreciated.

Jerry

KunleExcel · #2 07-07-2016, 04:08 AM

It is easy to do. However getting a sample data will help.

jrfoley3 · #3 07-07-2016, 06:26 AM

I have attached a sample of the file.
Thanks

KunleExcel · #4 07-08-2016, 01:10 AM

Code:

Sub ReadCellContent()

    Dim ColHeader As Range
    Set ColHeader = Range("A1", Range("A1").End(xlToRight))
    Dim ColData As Range
    
    For Each ColData In ColHeader
        If ColData.Offset(1, 0) = "" Then
            ColData.Interior.Color = vbYellow
        End If
       
        If ColData.Offset(1, 0) <> "" Then
            Dim ColRange As Range
            Dim lData As Range
            Set lData = Cells(Rows.Count, ColData.Column).End(xlUp) '.Row
            Set ColRange = Range(ColData.Offset(1, 0), lData)
            x = ColRange.Rows.Count
            y = WorksheetFunction.CountIf(ColRange, ColData.Offset(1, 0))
                If x = y Then
                 ColData.Interior.Color = vbGreen
                 Else
                 ColData.Interior.Color = vbRed
                End If
        End If
          
    Next ColData
End Sub

jrfoley3 · #5 07-08-2016, 12:21 PM

This works great...2 items:
1. Is there somewhere you can recommend that i can read to learn how to do this level of programming?
2. Was this request included: Second - run a macro that would tell me in the col that finds differences in data (#3 above), what percent of the cells are different.?

Many thanks for the great works and quick response....
Jerry

KunleExcel · #6 07-08-2016, 03:14 PM

Dear Jerry,

There are a lot of materials on the internet that teach vba. It is just for you to google.
I will look at the second part of your request asap. I kinda busy please bear with me.

Kunle

jrfoley3 · #7 07-08-2016, 03:22 PM

Much appreciated Kunle!

KunleExcel · #8 07-09-2016, 12:25 PM

Dear Jerry,

Apologies for getting back to you this late. I have added some line of Code to the earlier one to show the percentage of different cells in a Message Box. I hope you find it useful. Please let me know what you think.

Kunle

Code:

Sub ReadCellContent()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim ColHeader As Range
    Set ColHeader = Range("A1", Range("A1").End(xlToRight))
    Dim ColData As Range
    
    For Each ColData In ColHeader
        If ColData.Offset(1, 0) = "" Then
            ColData.Interior.Color = vbYellow
        End If
       
        If ColData.Offset(1, 0) <> "" Then
            Dim ColRange As Range
            Dim lData As Range
            Set lData = Cells(Rows.Count, ColData.Column).End(xlUp)
            Set ColRange = Range(ColData.Offset(1, 0), lData)
            x = ColRange.Rows.Count
            y = WorksheetFunction.CountIf(ColRange, ColData.Offset(1, 0))
                If x = y Then
                 ColData.Interior.Color = vbGreen
                 Else
                 ColData.Interior.Color = vbRed
                 Range(ColData, lData).Select
                 Selection.Copy
                 Sheets.Add
                 ActiveSheet.Paste
                 Application.CutCopyMode = False
                 ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes
                 Z = Range("A2", Range("A1").End(xlDown)).Count
                 i = Format(Z / x, "0.00%")
                 ActiveSheet.Delete
                 MsgBox i & " of cells are different in " & ColData.Value
                End If
        End If
          
    Next ColData
    
    Range("A1").Select
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to read text file and organize data in excel	srinidhi.mv88	Excel Programming	5	05-19-2015 12:06 AM
Macro will not read the value of cell with a formula in it!	grayson1231	Excel Programming	10	03-28-2015 03:47 PM
compare, match and count cell contents between sheets	bobsone1	Excel	11	08-07-2014 10:34 PM
Can anyone here tweek this macro for renaming Excel files based on a cell's contents?	chrisd2000	Excel Programming	6	07-01-2014 01:53 PM
Copy all comments & cell contents (i.e. data) to word?	IanM	Excel	0	07-03-2010 11:14 PM