Need help from Array VBA expert. Instead of formatting each cell in a range as per code below, is it possible to get this format included in Array so that once it write to back to range it is formatted at the same time of writing?
VBA Code:
Option Explicit
Sub Write_Array_With_Format()
Dim xArr, aArr, bArr, sArr(), oArr() As Variant, lRow, i As Long, x, A, B As Double
With Worksheets("Data") 'set data ranges to array
lRow = .Cells(Rows.Count, 2).End(xlUp).Row
xArr = .Range(.Cells(6, 2), .Cells(lRow, 2)).Value2
aArr = .Range(.Cells(6, 3), .Cells(lRow, 3)).Value2
bArr = .Range(.Cells(6, 4), .Cells(lRow, 4)).Value2
End With
ReDim sArr(LBound(xArr, 1) To UBound(xArr, 1), 1 To 1) 'String Array
sArr = Array("x A B", "A x B", "A B x", "x B A", "B x A", "B A x")
sArr = Application.Transpose(sArr)
ReDim oArr(LBound(xArr, 1) To UBound(xArr, 1), 1 To 1) 'Output Array
For i = 1 To UBound(xArr, 1)
x = xArr(i, 1): A = aArr(i, 1): B = bArr(i, 1)
If x > A And x > B And A > B Then
oArr(i, 1) = sArr(1, 1)
ElseIf x < A And x > B And A > B Then
oArr(i, 1) = sArr(2, 1)
ElseIf x < A And x < B And A > B Then
oArr(i, 1) = sArr(3, 1)
ElseIf x > A And x > B And A < B Then
oArr(i, 1) = sArr(4, 1)
ElseIf x > A And x < B And A < B Then
oArr(i, 1) = sArr(5, 1)
ElseIf x < A And x < B And A < B Then
oArr(i, 1) = sArr(6, 1)
End If
Next
With Worksheets("Data")
.Range(.Cells(6, 5), .Cells(lRow, 5)).Value2 = oArr 'write Output Array to Range
For i = 6 To lRow 'Format values
If .Range("E" & i).Value = "x A B" Then
With .Range("E" & i)
With .Characters(1, 1).Font
.Color = vbBlue
End With
With .Characters(3, 3).Font
.Underline = True
.Color = vbGreen
End With
End With
ElseIf .Range("E" & i).Value = "A x B" Then
With .Range("E" & i)
With .Characters(1, 2).Font
.Color = vbGreen
.Underline = True
End With
With .Characters(3, 1).Font
.Underline = True
.Color = vbBlue
End With
With .Characters(5, 1).Font
.Color = vbGreen
End With
End With
'And so on and so forth.............
End If
Next
End With
End Sub