I've got a function which merges cells in table if whole range has the same value (eg. if A1:G1 is equal to A2:B2 it will merge cells like A1&A2, B1&B2 etc. More here: How to check if two ranges value is equal ) Now I would like, to change color on table created by that funcion, like first row (doesn't matter if merged or no) filled with color, second blank etc. but I have no idea whether I should color it with merging function or create another which will detect new table with merged rows as one etc. Below is my code:
Sub test()
Dim i As Long, j As Long, k As Long, row As Long
row = Cells(Rows.Count, 2).End(xlUp).row
k = 1
For i = 1 To row Step 1
If Cells(i, 1).Value = "" Then Exit For
If Join(Application.Transpose(Application.Transpose(Range(Cells(i, 1), Cells(i, 3)))), Chr(0)) <> Join(Application.Transpose(Application.Transpose(Range(Cells(i + 1, 1), Cells(i + 1, 3)))), Chr(0)) Then
If i <> k Then
For j = 1 To 3 Step 1
Application.DisplayAlerts = False
Range(Cells(i, j), Cells(k, j)).Merge
Application.DisplayAlerts = True
Next j
End If
k = i + 1
End If
Next i
End Sub
Try:
Option Explicit
Sub test1()
Dim LastColumn As Long, LastRow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 2 To LastRow Step 2
.Range(Cells(i, 1), .Cells(i, LastColumn)).Interior.Color = vbGreen '<- You could change the color
Next i
End With
End Sub
Before:
After:
Edited Solution:
Option Explicit
Sub test1()
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rng = .UsedRange
.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "Table1"
.ListObjects("Table1").TableStyle = "TableStyleLight3"
End With
End Sub
Result:
So, after some time I've figured it out by myself. Below is the code:
Dim i As Long, j As Long, k As Long, l As Long, c As Integer
row = Cells(Rows.Count, 2).End(xlUp).row
k = 7
c = 1
For i = 7 To row Step 1
If Join(Application.Transpose(Application.Transpose(Range(Cells(i, 1), Cells(i, 3)))), Chr(0)) <> Join(Application.Transpose(Application.Transpose(Range(Cells(i + 1, 1), Cells(i + 1, 3)))), Chr(0)) Then
If i <> k Then
For j = 1 To 3 Step 1
Application.DisplayAlerts = False
Range(Cells(i, j), Cells(k, j)).Merge
Application.DisplayAlerts = True
Next j
End If
Select Case c
Case 0
Range(Cells(k, 1), Cells(k, 3)).Interior.Color = xlNone
c = 1
Case 1
For l = 0 To i - k Step 1
Range(Cells(k + l, 1), Cells(k + l, 3)).Interior.Color = RGB(217, 225, 242)
Next l
c = 0
End Select
k = i + 1
End If
Next i
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.