#1
|
|||
|
|||
Macro to read cell contents and compare data
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 |
#2
|
|||
|
|||
It is easy to do. However getting a sample data will help.
|
#3
|
|||
|
|||
Sample File Attached
I have attached a sample of the file.
Thanks |
#4
|
|||
|
|||
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 |
#5
|
|||
|
|||
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 |
#6
|
|||
|
|||
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 |
#7
|
|||
|
|||
Much appreciated Kunle!
|
#8
|
|||
|
|||
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 |
Tags |
data compare, macos |
|
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 |