VBA comparison with ActiveCell.Offset

[haudrauf64]

Hi there!
Sorry in advance for being stupid :-) first time working with VBA (and this forum)...

Goal: Some cells in B1:E1 (TC-0110 = main hazard) may differ to cells in F2:I2 (subhazard to TC-0110). I'd like to build a macro that marks these differences. It should be possible to select an orange cell and the macro does it's job in marking the differences in it's related subhazards.
29416

Question: I do not get how to apply a NOT-function (or something related) to compare the ranges but in relation to the ActiveCell. As the macro iterates trough the rows below the orange field, it should apply the conditional formatting to where it is at the moment (for example =NOT($B1=F3) when it is relating to TC-0112)

This is what I tried:


Sub ChangeMarker()
Dim Mainhazard As String
Mainhazard = ActiveCell.Value
Mainhazard = Right(ActiveCell.Value, 3)
Dim Subhazard As String
Subhazard = ActiveCell.Offset(i, 0).Value
Subhazard = Right(ActiveCell.Offset(i, 0).Value, 3)
'This should activate the Loop?
For i = 1 To Rows.Count
Next i
'Checks if Subhazard is belonging to the Mainhazard
If Mainhazard - Subhazard < 10 Then
'Select the range where the conditional formatting should apply (--> but does not work with i)
'Range("F2:I2").Select
'Range("B1:E1").Offset(1, 4).Select
Range(ActiveCell.Offset(1, 5), ActiveCell.Offset(1, 8)).Select
'This compares the hazard indicators of the mainhazard (ex. B1:E1) to the hazard indicators of the subhazard (ex.F2:I2)
'Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NOT(B$1=F2)"
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NOT(ActiveCell.Offset(0, 1).Range(ActiveCell, ActiveCell.Offset(0, 3))=ActiveCell.Offset(1,5).Range(ActiveCell, ActiveCell.Offset(0,3))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End If
End Sub
Thank you so much for any advide. I'm stuck here for ages!:banghead:
Greetz

[Bob Phillips]

Try this


Sub ChangeMarker()
Dim Mainhazard As String
Dim numSubs As Long
Dim lastrow As Long
Dim i As Long, ii As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To lastrow

Mainhazard = .Cells(i, "B").Value
numSubs = Application.CountIf(.Range("B2").Resize(lastrow - 1), Left$(Mainhazard, 5) & "**") - 1

With .Cells(i + 1, "G").Resize(numSubs, 4)

For ii = .FormatConditions.Count To 1 Step -1

.FormatConditions(ii).Delete
Next ii

.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & .Cells(0, -3).Address(True, False) & "<>" & .Cells(1, 1).Address(False, False)
With .FormatConditions(1)

.SetFirstPriority

With .Interior

.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With

.StopIfTrue = False
End With
End With

i = i + numSubs
Next i
End With
End Sub

[snb]

Conditional format will be your friend.
Please post a sample Excel file

In VBA:

Sub M_snb()
sn = Range("B1:I6")

for j = 1 to ubound(sn) step 3
for jj = 2 to 4
if sn(j,jj)<> sn(j+1,jj+4) then cells(j+1,jj).interior.colorindex=12
if sn(j,jj)<> sn(j+2,jj+4) then cells(j+2,jj).interior.colorindex=12
next
next
End Sub

[haudrauf64]

Hi Bob!
Sadly does not work...

Would it be an idea that the macro first checks the cells below an then works with the result of the equation?
Example: A1 (TC-0110) is selected. The macro checks the cells below (the yellow ones). If the most right 3 digits substracted are equal to 1-9 it adapts the conditional formatting to the according row.
- TC-0111 minus TC-0110 = 1 (conditional formatting is adapted to the first row below selected starting cell)
- TC-0112 minus TC-0110 = 2 (cf is adapted to the second row below selected starting cell)
- TC-0210 minus TC-0110 = 100 (cf is not adapted as it is not between 1-9)

I'll post a sample Excel file. Please feel free to try and adapt your first suggestion.

Thank you for your time!
Greetz

[haudrauf64]

Hi snb

This marks some cells but does not work properly...

I attached an Excel File. Feel free!

Thank you for your time! :)

Greetz

[Bob Phillips]

I tested it and it worked fine, or at least as I understood the requirement. Does it not work for you because you said the data started in B1 and my code worked with that, whereas now you say A1.

My code starts at B1, gets the main code, first five characters (e.g. TC-01) and finds how many rows below start with that code and sets conditional formats for those rows. It then moves onto the next block and repeats the process.

Maybe post the workbook, as snb suggested.

[snb]

You didn't add the macro I provided.

Use:


Sub M_snb()
sn = Range("B1:I6")

For j = 1 To UBound(sn) Step 3
For jj = 1 To 4
If sn(j, jj) <> sn(j + 1, jj + 4) Then Cells(j + 1, jj + 5).Resize(2).Interior.ColorIndex = 22
Next
Next
End Sub

In conditional Formatting:

[Bob Phillips]

As I said, it was you changing the details


Sub ChangeMarker()
Dim Mainhazard As String
Dim numSubs As Long
Dim lastrow As Long
Dim i As Long, ii As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow

Mainhazard = .Cells(i, "A").Value
numSubs = Application.CountIf(.Range("A1").Resize(lastrow), Left$(Mainhazard, 5) & "**") - 1

With .Cells(i + 1, "F").Resize(numSubs, 4)

For ii = .FormatConditions.Count To 1 Step -1

.FormatConditions(ii).Delete
Next ii

.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & .Cells(0, -3).Address(True, False) & "<>" & .Cells(1, 1).Address(False, False)
With .FormatConditions(1)

.SetFirstPriority

With .Interior

.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With

.StopIfTrue = False
End With
End With

i = i + numSubs
Next i
End With
End Sub

[haudrauf64]

Thanks! This works well in the dummysheet-excel. But is there any way to make the "Step 3" part flexible? As there are not always the same amount of subhazards this would be necessary.

See the attached file:

Thanks for your work & patience

[arnelgp]

Public Sub ChangeMarker()


Const main_sheet As String = "Sheet1"

Dim cel As Range
Dim last As Long
Dim i As Long, j As Long
Dim arr(1 To 4) As String

With Sheets(main_sheet)
last = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To last
Set cel = .Cells(i, 2)
With cel
If Len(.Value & "") Then
arr(1) = .Offset(0, 0)
arr(2) = .Offset(0, 1)
arr(3) = .Offset(0, 2)
arr(4) = .Offset(0, 3)
Else
For j = 4 To 7
If .Offset(0, j).Value & "" <> arr(j - 3) Then
.Offset(0, j).Interior.ColorIndex = 6
Else
.Offset(0, j).Interior.ColorIndex = -4142
End If
Next
End If
End With
Next
End With
End Sub

[haudrauf64]

You're absolutely right. Completely my fault.

Do you have any idea why cell "G3" is formatting even if it's not different?

See attached file:

29422

Thank you & sorry for the inconveniences!

[haudrauf64]

This works perfectly!

Thank you for your time!

[snb]

Sub M_snb()
sn = Cells(1).CurrentRegion

For j = 1 To UBound(sn)
If sn(j, 2) <> "" Then
For jj = 1 To UBound(sn)
If j + jj = UBound(sn) Or sn(j + jj, 2) <> "" Then Exit For
Next
If jj = 1 Then jj = 2
For jjj = 2 To 5
If sn(j, jjj) <> sn(j + 1, jjj + 4) Then Cells(j + 1, jjj + 4).Resize(jj - 1).Interior.ColorIndex = 22
Next
j = j + jj - 1
End If
Next
End Sub

[haudrauf64]

Hi snb!

This works well in the supplied excel file. I (somewhat) succeeded in adapting the code to a bigger range of data.

But if I change some cells (H6, G3 - should not be formatted) the macro doesn't get it. Do you have an idea why this might occur?

29423

Thank you for your time & have a nice weekend
Greetz

[snb]

Posting a representative sample is an art.


Sub M_snb()
sn = Cells(1).CurrentRegion

For j = 1 To UBound(sn)
If sn(j, 2) <> "" Then
y = j
Else
For jj = 2 To 5
If sn(y, jj) <> sn(j, jj + 4) Then Cells(j, jj + 4).Interior.ColorIndex = 22
Next
End If
Next
End Sub