Sub test2()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
With Range("A" & i)
Select Case .Value
Case ""
'Do nothing
Case "Description:", "Comment:"
.Resize(2).Cut Destination:=.Offset(, 1)
With .Resize(, 7)
.MergeCells = True
.WrapText = True
End With
With .Offset(1).Resize(, 7)
.MergeCells = True
.WrapText = True
End With
Case Else:
.Resize(, 7).Interior.ColorIndex = IIf(.Value Mod 2 = 0, 4, 5)
End Select
End With
Next i
End Sub
Sub test2()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
With Range("A" & i)
Select Case .Value
Case ""
'Do nothing
Case "Description:", "Comment:"
.Resize(2).Cut Destination:=.Offset(, 1)
With .Resize(, 7)
.MergeCells = True
.VerticalAlignment = xlBottom
.WrapText = True
End With
With .Offset(1).Resize(, 7)
.MergeCells = True
.VerticalAlignment = xlBottom
.WrapText = True
End With
Case Else:
If .Value Mod 2 = 0 Then 'Even
'
'code goes here
'
Else 'Odd
'
'code goes here
'
End If
End Select
End With
Next i
End Sub