Macro to select block of cells based on reference and hightlight cells in alternating colour

[Jack_Mason]

Hello, I have reference cells in column A which multiple rows in a block can be the same reference value. They arent in a numerical order so cant select evens/odds but I want to highlight the alternating ‘blocks’ of reference cells to make it easier to see the change in reference. If someone could help me with the code. I would like it to highlight columns A-K for each block

 

[lrobbo314]

How about this?

Book1 (version 2).xlsb
	A	B	C	D	E	F	G	H	I	J	K
1	A	90	98	23	55	40	41	61	25	27	58
2	A	73	70	77	86	17	87	31	80	65	85
3	A	85	61	59	13	77	38	40	19	21	65
4	B	74	20	77	88	32	26	45	78	36	89
5	B	40	11	78	22	77	44	98	63	17	65
6	C	25	96	7	75	61	22	73	59	16	79
7	C	48	73	16	93	91	16	84	99	14	5
8	C	77	54	7	98	15	73	58	99	20	97
9	C	72	84	95	46	86	94	20	2	75	98
10	D	45	76	100	18	1	13	44	83	7	70
11	D	3	82	29	19	93	96	77	11	37	40
12	E	87	35	20	14	61	8	17	7	25	80
13	E	70	12	60	1	7	18	100	84	15	23
14	E	6	64	73	43	52	34	68	66	80	59
15	E	40	25	3	82	62	100	22	38	81	47
16	F	75	79	57	49	100	47	51	1	5	1
17	F	43	26	19	83	82	99	64	85	10	57
18	F	82	85	34	43	100	4	6	42	81	53
19	G	36	85	76	29	31	86	99	71	81	47
20	G	74	87	92	47	51	36	48	3	64	18
21	G	35	49	91	89	34	98	49	56	2	84
Sheet6

Sub ALT()
Dim AR() As Variant: AR = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value2
Dim s As String: s = "A1:"
Dim tmp As String: tmp = AR(1, 1)
Dim b As Boolean: b = True

For i = 2 To UBound(AR)

If AR(i, 1) <> tmp Then
    If b Then
        s = s & "K" & i - 1 & ","
        tmp = AR(i, 1)
    Else
        s = s & "A" & i & ":"
        tmp = AR(i, 1)
    End If
    b = Not b
End If

Next i
If Right(s, 1) = ":" Then
    s = s & "K" & i - 1
Else
    s = Left(s, Len(s) - 1)
End If
Range(s).Interior.Color = RGB(225, 225, 225)
End Sub

 

[Jack_Mason]

How about this?

Book1 (version 2).xlsb
	A	B	C	D	E	F	G	H	I	J	K
1	A	90	98	23	55	40	41	61	25	27	58
2	A	73	70	77	86	17	87	31	80	65	85
3	A	85	61	59	13	77	38	40	19	21	65
4	B	74	20	77	88	32	26	45	78	36	89
5	B	40	11	78	22	77	44	98	63	17	65
6	C	25	96	7	75	61	22	73	59	16	79
7	C	48	73	16	93	91	16	84	99	14	5
8	C	77	54	7	98	15	73	58	99	20	97
9	C	72	84	95	46	86	94	20	2	75	98
10	D	45	76	100	18	1	13	44	83	7	70
11	D	3	82	29	19	93	96	77	11	37	40
12	E	87	35	20	14	61	8	17	7	25	80
13	E	70	12	60	1	7	18	100	84	15	23
14	E	6	64	73	43	52	34	68	66	80	59
15	E	40	25	3	82	62	100	22	38	81	47
16	F	75	79	57	49	100	47	51	1	5	1
17	F	43	26	19	83	82	99	64	85	10	57
18	F	82	85	34	43	100	4	6	42	81	53
19	G	36	85	76	29	31	86	99	71	81	47
20	G	74	87	92	47	51	36	48	3	64	18
21	G	35	49	91	89	34	98	49	56	2	84
Sheet6

Sub ALT()
Dim AR() As Variant: AR = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value2
Dim s As String: s = "A1:"
Dim tmp As String: tmp = AR(1, 1)
Dim b As Boolean: b = True

For i = 2 To UBound(AR)

If AR(i, 1) <> tmp Then
    If b Then
        s = s & "K" & i - 1 & ","
        tmp = AR(i, 1)
    Else
        s = s & "A" & i & ":"
        tmp = AR(i, 1)
    End If
    b = Not b
End If

Next i
If Right(s, 1) = ":" Then
    s = s & "K" & i - 1
Else
    s = Left(s, Len(s) - 1)
End If
Range(s).Interior.Color = RGB(225, 225, 225)
End Sub

Thank you, I get a bug with the final line (method ‘Range’ of object’_global’ failed) error 1004?

 

[lrobbo314]

Can you post a sample of your data? It seems to be working fine with the sample data I posted.

 

[Jack_Mason]

N

Can you post a sample of your data? It seems to be working fine with the sample data I posted.

Never mind, it worked! Thank you so much! You’ve saved me a lot of work!

 

[lrobbo314]

Cool. Here's a slightly cleaned up version of the code.

Sub ALT()
Dim AR() As Variant:    AR = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value2
Dim s As String:        s = "A1:"
Dim tmp As String:      tmp = AR(1, 1)
Dim b As Boolean:       b = True

For i = 2 To UBound(AR)

If AR(i, 1) <> tmp Then
    If b Then
        s = s & "K" & i - 1 & ","
    Else
        s = s & "A" & i & ":"
    End If
    tmp = AR(i, 1)
    b = Not b
End If

Next i

If b Then
    s = s & "K" & i - 1
Else
    s = Left(s, Len(s) - 1)
End If

Range(s).Interior.Color = RGB(225, 225, 225)
End Sub