Compare Each Cell in Columns (with some alternates) and format cell, if condition is met (True)

[ANALYSTBANK]

My current data sheet looks as under;

Row	ColumnK	ColumnL	ColumnM	ColumnN	ColumnO
3					21-Sep-2013
4					27-Sep-2013
5					03-Oct-2013
6					11-Oct-2013
7					23-Oct-2013
8				17-Sep-2013
9				01-Oct-2013
10				08-Oct-2013
11				23-Oct-2013
12			29-Sep-2013
13			11-Oct-2013
14			13-Oct-2013
15			20-Oct-2013
16		24-Sep-2013
17		21-Oct-2013
18	21-Sep-2013
19	23-Sep-2013
20	02-Oct-2013
21	13-Oct-2013
22	22-Oct-2013
23	26-Oct-2013

<tbody>
</tbody>

I want a macro that would start reading each cells in Column K from Cell K3 (till last row say K100), and do following;

1) If cell is Empty in ColumnK (say K3), move down to next cell (say K4) in ColumnK
2) When Data is found in above case, say K18, it should compare
either a) Exact date (i.e. 21Sep13), or
b) 1 day after (22Sep13), or
c) 2 day after (23Sep13) OR
d) 1 day before (20Sep13) , or
e) 2 day before (19Sep13)

in each cell in Column L


When date is found per above criteria in ColumnL, the cell should be highlighted either by COLOR or BOLD

3) Then counter should is moved down to Cell K19 (immediate cell below K18) and repeat the process as given in 2

4) This process should be repeated till Cell K100 which is the last range.


For illustration purpose, I’ve manually highlighted Cell K22 (Date 22Oct13) and L17 (having date 21Oct13), which is just one day before as explained in 2(d) above.

There could be case, where cell has date that meets criteria more than once, I guess, that should not be the problem, as formatting (COLOR or BOLD) could be overwritten, and last hit will always be highlighted.

So, the first comparison is between Column K and Column L, and that is where I need your help.

I will repeat the process later for comparison between Column L and Column M, and then Column M, and N and so on, BUT FIRST COLUMN COMPARISON between ColumnK, and ColumnL, I need help.

How to do it?

Thanks

 

[kevatarvind]

hi try below

Option Explicit
Sub Compare_Column()
Dim i, j, k As Integer
Dim lr As Long
For j = 11 To 14 ' Change The No 14 To other 14 will cover till Column "O" so if you need to compare more column just change the no 15,16..so on or whatever you want
    lr = Cells(Rows.Count, j).End(xlUp).Row
    For i = 3 To lr
        For k = 3 To lr
            If Cells(i, j) <> "" And IsDate(Cells(i, j)) Then
                If Cells(i, j) - Cells(k, j + 1) <= 2 And Cells(i, j) - Cells(k, j + 1) >= -2 Then
                    Cells(i, j).Interior.ColorIndex = 6
                    Cells(i, j).Font.Bold = True
                    Cells(k, j + 1).Interior.ColorIndex = 8
                    Cells(k, j + 1).Font.Bold = True
                End If
            End If
        Next
    Next
Next
End Sub

 

[ANALYSTBANK]

Thank you very much. This works like a Charm.

Just could not make out why u used different Color (Index 6 & Index8)

Nonetheless, this is what i was looking for. Thanks again.

Just one last query for this now, since wherever match is found, those cells are colored and marked as BOLD. Certain cells that does not match with each other, have remained as it is, i.e. unformatted, not BOLD, no Color,

How to delete such unfomatted cells, so that, only resultant relevant cells (which is already formatted, colored+bold) remains in the sheet.

Thanks A Ton, Brother.

 

[kevatarvind]

Just could not make out why u used different Color (Index 6 & Index8)

just bcoz of you can know color index 8 blue color is for match found in previous column and index 6 yellow for match found in next column so if u don't required then you can change as u like

Just one last query for this now, since wherever match is found, those cells are colored and marked as BOLD. Certain cells that does not match with each other, have remained as it is, i.e. unformatted, not BOLD, no Color,

How to delete such unfomatted cells, so that, only resultant relevant cells (which is already formatted, colored+bold) remains in the sheet.

try below code

Option Explicit
Sub Compare_Column()
Dim i, j, k, l, x As Integer
Dim lr, lastcol, lr1 As Long
Dim cell As Range
lastcol = 14 ' Change The No 14 To other 14 will cover till Column "O" so if you need to compare more column just change the no 15,16..so on or whatever you want
Application.ScreenUpdating = False
For j = 11 To lastcol
    lr = Cells(Rows.Count, j).End(xlUp).Row
    For i = 3 To lr
        For k = 3 To lr
            If Cells(i, j) <> "" And IsDate(Cells(i, j)) Then
                If Cells(i, j) - Cells(k, j + 1) <= 2 And Cells(i, j) - Cells(k, j + 1) >= -2 Then
                    Cells(i, j).Interior.ColorIndex = 6
                    Cells(i, j).Font.Bold = True
                    Cells(k, j + 1).Interior.ColorIndex = 8
                    Cells(k, j + 1).Font.Bold = True
                End If
            End If
        Next
    Next
Next
For l = 11 To lastcol + 1
    lr1 = Cells(Rows.Count, l).End(xlUp).Row
    For x = lr1 To 3 Step -1
        If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).Delete Shift:=xlUp
    Next
Next
Application.ScreenUpdating = True
End Sub

 

[ANALYSTBANK]

@Arvind

Thanks, but the second part of the code, does not bring the desired result. I feel, I',m not putting it clearly, else it is easy to do, and am very close to my answer. Thanks for your all support.

 

[ANALYSTBANK]

Simply, Code should be


Range("C3:V500").select
for each cell within above range IF .Interior.ColorIndex is XLNone, then clear cell content and make it Blank

Do not move such cell UP or DOWN, and let it remain at its current location

 

[kevatarvind]

ok just change

this line

If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).Delete Shift:=xlUp

to this

If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).ClearContents

 

[ANALYSTBANK]

My all concerns resolved. Thank you very much.

 

[ANALYSTBANK]

@Sir, Kevatarvind

I just changed (expanded the column range starting from 5, instead of 11) and code is as under:

I was just comparing my manual reading with the cells that remains highlighted after running the following code. my Observation is that in Cell M34, I've date 20/Oct, and in Cell Q8, I've date 19/Oct , just -1 day, but when i run the macro, both cells M34, and Q8 DOES not appear, how is it possible, what modification is required?

Sub ColCompFinal()


Dim i, j, k, l, x As Integer
Dim lr, lastcol, lr1 As Long
Dim cell As Range
lastcol = 22 ' Change The No 14 To other 14 will cover till Column "O" so if you need to compare more column just change the no 15,16..so on or whatever you want


Application.ScreenUpdating = False


For j = 5 To lastcol
lr = Cells(rows.Count, j).End(xlUp).Row
For i = 3 To lr
For k = 3 To lr
If Cells(i, j) <> "" And IsDate(Cells(i, j)) Then
If Cells(i, j) - Cells(k, j + 1) <= 2 And Cells(i, j) - Cells(k, j + 1) >= -2 Then
Cells(i, j).Interior.ColorIndex = 16 '6
Cells(i, j).Font.Bold = True
Cells(k, j + 1).Interior.ColorIndex = 18 '8
Cells(k, j + 1).Font.Bold = True
End If
End If
Next
Next
Next


For l = 5 To lastcol + 1
lr1 = Cells(rows.Count, l).End(xlUp).Row
For x = lr1 To 3 Step -1
If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).Delete Shift:=xlUp
' If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).ClearContents
Next
Next
Application.ScreenUpdating = True
End Sub

 

[ANALYSTBANK]

ok just change

this line

If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).Delete Shift:=xlUp

to this

If Cells(x, l).Interior.ColorIndex = xlNone Then Cells(x, l).ClearContents

What should be the code line, if Cell is Empty in each Column, move(shift) cell up in same column, but restrict it to row 3 only in current example.