Easy Read Data With Row Coloring:Coding

Very often mass data imported into excel spreadsheet for analysis or report to be presented, make us blur with similar information between one row and another. One way to make thing better is coloring the row with different color, but what shall we do with thousands of records? seem to be impossible with manual one. This comes to this piece of coding "Easy Read Data With Row Coloring", Hope this helps all happier with mass data analysis and save your time from tiring and boring daily manual task

Add this code to the module of your spreadsheet, then run it
Example file attachment is provided.

Sub EasyReadDataColoring()

    UserSpecifyCol = InputBox("Please indicate the column to use as Condition")
    RefCol = Cells(2, UserSpecifyCol).Column + 1

    Range("A:A").EntireColumn.Insert
    Cells(2, RefCol).Select

   Do Until ActiveCell.Value = ""

    If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
        Cells(ActiveCell.Row, "A").Value = Cells(ActiveCell.Row - 1, "A").Value
    Else
        Cells(ActiveCell.Row, "A").Value = Cells(ActiveCell.Row - 1, "A").Value + 1
     End If
     ActiveCell.Offset(1, 0).Select
Loop

Range("A2").Select
CurrRow = ActiveCell.Row
ChkCol = Range("IV1").End(xlToLeft).Column

Do Until ActiveCell.Value = ""
    CurrRow = ActiveCell.Row
    ChkCol = Range("IV1").End(xlToLeft).Column
    If ActiveCell.Value Mod 2 = 0 Then
    Range("A" & CurrRow & ":" & Cells(CurrRow, ChkCol).Address).Interior.ColorIndex = 16
    Else
    Range("A" & CurrRow & ":" & Cells(CurrRow, ChkCol).Address).Interior.ColorIndex = 15
    End If
    ActiveCell.Offset(1, 0).Select
Loop
Range("A:A").Delete

End Sub