Need VBA code to Match 5 columns and mark unchanged/changed in next cell

[billigee]

Dear All,

I am working with a sheet where there is a cost of products for 5 months from column A to E, I want to check if there is any change in price in any month then it should mention CHANGED in column F or UNCHANGED in column F

the criteria is TRUE figure (UNCHANGED) is

if amount in all 5 columns is same
if amount of 1 column is blank or zero and other 4 column are same
if amount of more than 1 column is blank or zero and rest of columns are same

Then the result should be UNCHANGED

otherwise it should mentioned CHANGED

to make it more clear see snapshot

Thankyou

 

[billigee]

Thanks for your time, let see if anyone can get me a solution

 

[Micron]

I did not notice that comment. Thanks for pointing that out

You know what's worse than missing things like that on a page of posts (which is just oversight that we all do from time to time)? The forum design where the first post is at the top of subsequent pages. You land on page 2 and see the 1st post at the top. It's information or questions that are likely not initially phrased properly, or just wrong - like that chart. Anyone landing there starts off with the wrong information. I always have to go back and find out what the last post was when I should be landing there instead. It's a pet peeve of mine but I know I'll have to live with it.

 

[Peter_SSs]

Does it have to be a vba solution?

Book1
	A	B	C	D	E	F
2	5	5	5	5	5	UNCHANGED
3	5		5	0	5	UNCHANGED
4	5	0	0	0	0	UNCHANGED
5	0	5	5			UNCHANGED
6	0	5	6	0	0	CHANGED
Sheet1

Cell Formulas
Range	Formula
F2:F6	F2	=LET(f,FILTER(A2:E2,A2:E2>0),IF(MAX(f)=MIN(f),"UNCHANGED","CHANGED"))

 

[Peter_SSs]

Does it have to be a vba solution?

If it does then you could try this. I have assumed that each row will have at least one price > 0. If that is not a valid assumption then a tweak will be needed.

Sub Unchanged()
  Dim a As Variant, x As Variant
  Dim i As Long
  
  With Range("A2:E" & Columns("A:E").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)
    a = .Value
    For i = 1 To UBound(a)
      x = Filter(Filter(Split("|" & Join(Application.Index(a, i, 0), "|#|") & "|", "#"), "||", False), "|0|", False)
      a(i, 1) = "UNCHANGED"
      If Len(Trim(Replace(Join(x), x(0), ""))) > 0 Then a(i, 1) = "CHANGED"
    Next i
    .Offset(, .Columns.Count).Resize(, 1).Value = a
  End With
End Sub

My sample data and results of the code

billigee.xlsm
	A	B	C	D	E	F
1	Jan	Feb	Mar	Apr	May	Remarks
2	5	5	5	5	5	UNCHANGED
3	5		5	0	5	UNCHANGED
4	5	0	0	0	0	UNCHANGED
5	0	5	5			UNCHANGED
6	0	5	6	0	0	CHANGED
7				5		UNCHANGED
Sheet3

 

[Micron]

Holy Moley! I just arrived at a complicated solution - 17 minutes late!! I'm going to post it anyway, in spite of the fact that it's probably overkill. Maybe a much larger data set will cause one of the solutions to fail while the other works. Who knows?
Where I really struggled was building an array over columns. So many posted solutions were for arrays over rows and what I tried to apply to columns just frustrated the heck out of me. I dragged the function call down a column: =PriceChange(F1:J1) so there's no hard coding of rows or columns.

Function PriceChange(rng As Range) As String
Dim ary() As Variant, tmpAry() As Variant
Dim i As Integer, j As Integer
Dim lngVal As Long, lngVal2 As Long

With rng
    ary = .Value
    For i = 1 To .Rows.count
        ReDim tmpAry(1 To .Columns.count)
        For j = 1 To .Columns.count
            tmpAry(j) = ary(i, j)
            'Debug.Print ary(i, j)
            'Debug.Print tmpAry(j)
            If tmpAry(j) > 0 And j = 1 Then lngVal = tmpAry(j)
            If tmpAry(j) > 0 And j > 1 Then lngVal = tmpAry(j)
            If tmpAry(j) > 0 And j > 1 And lngVal2 = 0 Then lngVal2 = tmpAry(j)
            If lngVal2 <> 0 And lngVal <> 0 And lngVal <> lngVal2 Then
               PriceChange = "Changed"
            Else
               PriceChange = "Unchanged"
            End If
        Next j
   Next i
End With

End Function

RESULTS

5​	5​	5​	5​	5​	Unchanged
5​		5​	0​	5​	Unchanged
5​	0​	0​	0​	0​	Unchanged
0​	5​	5​			Unchanged
0​	5​	6​	0​	0​	Changed

 

[bebo021999]

I came up with different approach. Try to count unique price >0, if >1 then CHANGED
In F1, use UDF:
=PriceChange(A1:E1)
with below code:

Function PriceChange(ByVal rng As Range)
Dim count&, cell As Range
    With CreateObject("scripting.dictionary")
        For Each cell In rng
            If Not .exists(cell.Value) And cell.Value > 0 Then
                .Add cell.Value, ""
                count = count + 1
            End If
        Next
    End With
PriceChange = IIf(count = 1, "UN", "") & "CHANGED"
End Function

 

[Micron]

THAT is friggin' awesome!
Honestly, how much time did you spend coming up with that?

 

[bebo021999]

THAT is friggin' awesome!
Honestly, how much time did you spend coming up with that?

Who did you mention to? I guess it's me. haha

At first glance, I though of unique price >0, => "dictionary" : 10s

The rest took me 5 min

But, all my above comment would be priceless, if my code went wrong.

Wait for OP's confirmation.

 

[Micron]

Dictionary is something that I was going to learn but being retired and having no prospect of coding for Access or otherwise, I just never bothered to pick it up. Same with RegEx - just don't have much of a need. I'm sure OP will find your code more than satisfactory; much easier to maintain for sure.

 

[bebo021999]

Dictionary is something that I was going to learn but being retired and having no prospect of coding for Access or otherwise, I just never bothered to pick it up. Same with RegEx - just don't have much of a need. I'm sure OP will find your code more than satisfactory; much easier to maintain for sure.

Just take it easy. Dictionary just like 2-D array, but it require unique keys.