Comparing text values in two cells and adding a "1" to the appropriate result column.

[Tim5099]

Hello all,

I'm hoping someone can help me out. I have an excel file with some data in it. I have two columns with one of four words in it. For simplicity I'll call them RED, GREEN, BLUE, and Yellow. A few columns over I have columns "Same" "Good" and "Bad". I'm trying to figure out a way to get excel to put a 1 in the appropriate column, if cell A1 is Red I need excel to look at the word in cell B2 and put a 1 in the "same" column if A1 and B1 are the same word. If the word in B2 is Yellow I need excel to put a 1 in the "Good" column. If the word in B1 is GREEN or BLUE I need it to put a 1 in the bad column. The tricky part is each of the four words RED, GREEN, BLUE, and Yellow have a different set of words that will be called "good" or "bad". So if the word in cell A1 if Green for example it will have a different set of good and bad color words.

So it seems I need four different functions depending on what word is in A1. In the column next to these lists of words I have the date which I'll need to use to give me the sums of same, good, and bad for each day. But first things first. I think I need to use a combination of IF functions and MATCH function, but I can't figure out anything that works. Below is what I'm hoping it will look like when I've got the right formulas.

Any help is very much appreciated!

First column	Second column	Date		Same	Good	Bad
RED	RED	4/1/2013		1
RED	YELLOW	4/1/2013			1
RED	GREEN	4/1/2013				1
BLUE	YELLOW	4/1/2013
YELLOW		4/1/2013
GREEN		4/1/2013

<tbody>
</tbody>

 

[Peter_SSs]

When I switch in the letters from the data sheet I'll be all set.

Maybe, but you need to be careful when joining cell values without delimiting them in some way.
I know you said ..

.. both column A and B will always have one of the four colors (words).

.. but just in case I would make a slight change to Aladin's suggestion, especially since your real values can be "A" or "AA".

To demonstrate. Here's my 'Admin' sheet with the blue area named ColorTable and my suggested delimited values in the green area named Color_Table

Excel Workbook
	A	B	C	D	E
1	ColorTable			Color_Table
2	AA	SAME		A|A	SAME
3	AAA	GOOD		A|AA	GOOD
4	AO	BAD		A|O	BAD
5	AB	BAD		A|B	BAD
6
7	BB	SAME		B|B	SAME
8	BAA	GOOD		B|AA	GOOD
9	BO	BAD		B|O	BAD
10	BA	BAD		B|A	BAD
11
12	OO	SAME		O|O	SAME
13	OAA	GOOD		O|AA	GOOD
14	OA	GOOD		O|A	GOOD
15	OB	GOOD		O|B	GOOD
16
17	AAAA	SAME		AA|AA	SAME
18	AAA	BAD		A|AA	BAD
19	AAB	BAD		A|AB	BAD
20	AAO	BAD		A|AO	BAD
21
Admin

And here is the other sheet. You can see what happens in the yellow cells IF either column contains "AA" & the other column is blank.
So, just to be on the safe side I would use a lookup table like the green one and the slightly changed formula as shown in cell I2 , still copied across and down.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1	X	Y	Date		Same	Good	Bad		Same	Good	Bad
2	A	A	4/01/13		1				1
3	A	AA	4/01/13			1				1
4	A	B	4/01/13				1				1
5	O	AA	4/01/13			1				1
6	AA		4/01/13		1
7	B		4/01/13
8		AA	4/01/13		1
Tim5099

#VALUE!

</td></tr></table></td></tr></table>

 

[Aladin Akyurek]

Thank you! That works great on replacement words I used in the example. When I switch in the letters from the data sheet I'll be all set. Thanks again.

You are welcome. If you insist on switching to values like A and AA, you'll need a separator, an additional char, say a |, to distinguish between the combinations. I should have done so even with color coding. See Peter's post that picks this up.

 

[Rick Rothstein]

If you are still willing to use a macro, I think this one will work correctly with the letters you showed us...

Sub Colors()
  Dim X As Long, LastRow As Long
  Const StartRow As Long = 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Cells(StartRow, "C").Resize(LastRow - StartRow + 1, 3).Clear
  For X = StartRow To LastRow
    If Cells(X, "A").Value = Cells(X, "B").Value Then
      Cells(X, "C").Value = 1
    ElseIf Len(Cells(X, "B")) Then
      Select Case Cells(X, "A").Value
        Case "A", "B"
          Select Case Cells(X, "B").Value
            Case "AA": Cells(X, "D").Value = 1
            Case Else: Cells(X, "E").Value = 1
          End Select
        Case "O": Cells(X, "D").Value = 1
        Case "AA": Cells(X, "E").Value = 1
      End Select
    End If
  Next
End Sub

 

[Peter_SSs]

Firstly, note that cells D18:D20 in my 'Admin' sheet in post #11 are incorrect. The "|" delimiter should be after the second character, not after the first character.


Secondly, if you are considering a macro approach, and noting that you mention that you have "thousands of rows", you may consider this faster alternative.
My code has one difference to Rick's in terms of results produced and that is if there are any rows where columns A & B are both blank. It may not be possible with your data and therefore doesn't matter but in such a case, Rick's code returns a 1 in the "Same" column whereas mine leaves the result columns all blank on that row. If you prefer the 1 in the "Same" if this happens, then change the relevant line in my code to this

Case "|", "A|A", "B|B", "O|O", "AA|AA": c = 1

Sub SameGoodBad()
  Dim lr As Long, r As Long, rws As Long, c As Long
  Dim a, b
 
  Const fr As Long = 2      '<- First row of actual data
  Const rc As String = "E"  '<- First result column
  
  lr = Columns("A:C").Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
  rws = lr - fr + 1
  a = Range("A" & fr).Resize(rws, 2).Value
  ReDim b(1 To rws, 1 To 3)
  For r = 1 To rws
    Select Case a(r, 1) & "|" & a(r, 2)
      Case "A|A", "B|B", "O|O", "AA|AA": c = 1
      Case "A|AA", "B|AA", "O|AA", "O|A", "O|B": c = 2
      Case "A|O", "A|B", "B|O", "B|A", "AA|A", "AA|B", "AA|O": c = 3
      Case Else: c = 0
    End Select
    If c Then
      b(r, c) = 1
    End If
  Next r
  Cells(fr, rc).Resize(rws, 3).Value = b
End Sub

 

[Rick Rothstein]

Sub SameGoodBad()
  Dim lr As Long, r As Long, rws As Long, c As Long
  Dim a, b
 
  Const fr As Long = 2      '<- First row of actual data
  Const rc As String = "E"  '<- First result column
  
  lr = Columns("A:C").Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
 rws = lr - fr + 1
  a = Range("A" & fr).Resize(rws, 2).Value
  ReDim b(1 To rws, 1 To 3)
  For r = 1 To rws
    Select Case a(r, 1) & "|" & a(r, 2)
      Case "A|A", "B|B", "O|O", "AA|AA": c = 1
      Case "A|AA", "B|AA", "O|AA", "O|A", "O|B": c = 2
      Case "A|O", "A|B", "B|O", "B|A", "AA|A", "AA|B", "AA|O": c = 3
      Case Else: c = 0
    End Select
   If c Then
      b(r, c) = 1
    End If
 Next r
  Cells(fr, rc).Resize(rws, 3).Value = b
End Sub

Two comments...

1) I would change the calculation for the last row (red highlighted text) to this simpler calculation...

lr = Cells(Rows.Count, "A").End(xlUp).Row

Think about it... if Column A is the "long column", it will produce the same value for lr as your original code line did. On the other hand, if Column A has blank cells at the end compared to Columns B or C, its calculation for lr will be less than from your original code, but that won't matter because the rows that will be skipped were not going to output a 1 anywhere anyhow.

2) Why did you separate the part I highlighted in green like that... you could have included the assignments to the array directly in the Case statements... doing that avoids some extra code line executions for each loop which should speed things up ever so slightly (not to mention it shortens your code by four lines... four because you also no longer need the Case Else statement).

The following modification to your code above implements the two ideas I outlined above...

Sub SameGoodBad()
  Dim lr As Long, r As Long, rws As Long, c As Long
  Dim a, b
 
  Const fr As Long = 2      '<- First row of actual data
  Const rc As String = "E"  '<- First result column
  
  lr = Cells(Rows.Count, "A").End(xlUp).Row
  rws = lr - fr + 1
  a = Range("A" & fr).Resize(rws, 2).Value
  ReDim b(1 To rws, 1 To 3)
  For r = 1 To rws
    Select Case a(r, 1) & "|" & a(r, 2)
      Case "A|A", "B|B", "O|O", "AA|AA": b(r, 1) = 1
      Case "A|AA", "B|AA", "O|AA", "O|A", "O|B": b(r, 2) = 1
      Case "A|O", "A|B", "B|O", "B|A", "AA|A", "AA|B", "AA|O": b(r, 3) = 1
    End Select
  Next r
  Cells(fr, rc).Resize(rws, 3).Value = b
End Sub

 

[Aladin Akyurek]

Firstly, note that cells D18:D20 in my 'Admin' sheet in post #11 are incorrect. The "|" delimiter should be after the second character, not after the first character.


Secondly, if you are considering a macro approach, and noting that you mention that you have "thousands of rows", you may consider this faster alternative.
My code has one difference to Rick's in terms of results produced and that is if there are any rows where columns A & B are both blank. It may not be possible with your data and therefore doesn't matter but in such a case, Rick's code returns a 1 in the "Same" column whereas mine leaves the result columns all blank on that row. If you prefer the 1 in the "Same" if this happens, then change the relevant line in my code to this

Case "|", "A|A", "B|B", "O|O", "AA|AA": c = 1

Sub SameGoodBad()
  Dim lr As Long, r As Long, rws As Long, c As Long
  Dim a, b
 
  Const fr As Long = 2      '<- First row of actual data
  Const rc As String = "E"  '<- First result column
  
  lr = Columns("A:C").Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
  rws = lr - fr + 1
  a = Range("A" & fr).Resize(rws, 2).Value
  ReDim b(1 To rws, 1 To 3)
  For r = 1 To rws
    Select Case a(r, 1) & "|" & a(r, 2)
      Case "A|A", "B|B", "O|O", "AA|AA": c = 1
      Case "A|AA", "B|AA", "O|AA", "O|A", "O|B": c = 2
      Case "A|O", "A|B", "B|O", "B|A", "AA|A", "AA|B", "AA|O": c = 3
      Case Else: c = 0
    End Select
    If c Then
      b(r, c) = 1
    End If
  Next r
  Cells(fr, rc).Resize(rws, 3).Value = b
End Sub

Two comments...

1) I would change the calculation for the last row (red highlighted text) to this simpler calculation...

lr = Cells(Rows.Count, "A").End(xlUp).Row

Think about it... if Column A is the "long column", it will produce the same value for lr as your original code line did. On the other hand, if Column A has blank cells at the end compared to Columns B or C, its calculation for lr will be less than from your original code, but that won't matter because the rows that will be skipped were not going to output a 1 anywhere anyhow.

2) Why did you separate the part I highlighted in green like that... you could have included the assignments to the array directly in the Case statements... doing that avoids some extra code line executions for each loop which should speed things up ever so slightly (not to mention it shortens your code by four lines... four because you also no longer need the Case Else statement).

The following modification to your code above implements the two ideas I outlined above...

Sub SameGoodBad()
  Dim lr As Long, r As Long, rws As Long, c As Long
  Dim a, b
 
  Const fr As Long = 2      '<- First row of actual data
  Const rc As String = "E"  '<- First result column
  
  lr = Cells(Rows.Count, "A").End(xlUp).Row
  rws = lr - fr + 1
  a = Range("A" & fr).Resize(rws, 2).Value
  ReDim b(1 To rws, 1 To 3)
  For r = 1 To rws
    Select Case a(r, 1) & "|" & a(r, 2)
      Case "A|A", "B|B", "O|O", "AA|AA": b(r, 1) = 1
      Case "A|AA", "B|AA", "O|AA", "O|A", "O|B": b(r, 2) = 1
      Case "A|O", "A|B", "B|O", "B|A", "AA|A", "AA|B", "AA|O": b(r, 3) = 1
    End Select
  Next r
  Cells(fr, rc).Resize(rws, 3).Value = b
End Sub

If I would do this in my favorite programming language, Lisp, I'd never encode the relevant table in the code itself, unless there is a smart reason for doing so. Why do VBA folks opt for such so often?

 

[Peter_SSs]

Two comments...

1) I would change the calculation for the last row (red highlighted text) to this simpler calculation...

lr = Cells(Rows.Count, "A").End(xlUp).Row

Think about it... if Column A is the "long column", it will produce the same value for lr as your original code line did. On the other hand, if Column A has blank cells at the end compared to Columns B or C, its calculation for lr will be less than from your original code, but that won't matter because the rows that will be skipped were not going to output a 1 anywhere anyhow.

Given the OP said cols A & B would each have values, using column A would most likely be the way to go anyway. We don't know how columns A & B are populated or whether the values ever change & the code run again. One reason I was trying to make sure I had the very bottom row was to avoid having to separately clear the result area of any existing "1"s from an earlier code run. That may be completely irrelevant in the OP's case, and my method doesn't guarantee there isn't existing data further down the sheet anyway, so I'm not too fussed about how lr is calculated unless we learn more.

2) Why did you separate the part I highlighted in green like that...

Because I didn't think to do it any other way. I like your suggestion here!

If I would do this in my favorite programming language, Lisp, I'd never encode the relevant table in the code itself, unless there is a smart reason for doing so. Why do VBA folks opt for such so often?

Aladin, do you mean loading the table into an array like this?

a = Range("A" & fr).Resize(rws, 2).Value

If so the answer is speed.
To demonstrate. Fill 1,000,000 cells, manually or with this

Sub Data()
  Range("A1:A1000000").Value = "x"
End Sub

Now separately run these two macros. Each just reads each of the 1,000,000 values into a variable.
For me, the first code takes 0.316 seconds, the second takes 4.059 seconds

Sub LoadingArray()
  Dim t As Single
  Dim x As String
  Dim r As Long
  Dim a
  
  t = Timer
  a = Range("A1:A1000000").Value
  For r = 1 To 1000000
    x = a(r, 1)
  Next r
  MsgBox "Code took " & Format(Timer - t, "0.000 secs")
End Sub

Sub NotLoadingArray()
  Dim t As Single
  Dim x As String
  Dim r As Long
  
  t = Timer
  For r = 1 To 1000000
    x = Cells(r, "A").Value
  Next r
  MsgBox "Code took " & Format(Timer - t, "0.000 secs")
End Sub

If you meant something else, please clarify.

 

[Aladin Akyurek]

...
Aladin, do you mean loading the table into an array like this?

a = Range("A" & fr).Resize(rws, 2).Value

If so the answer is speed.
To demonstrate. Fill 1,000,000 cells, manually or with this

Sub Data()
  Range("A1:A1000000").Value = "x"
End Sub

Now separately run these two macros. Each just reads each of the 1,000,000 values into a variable.
For me, the first code takes 0.316 seconds, the second takes 4.059 seconds

Sub LoadingArray()
  Dim t As Single
  Dim x As String
  Dim r As Long
  Dim a
  
  t = Timer
  a = Range("A1:A1000000").Value
  For r = 1 To 1000000
    x = a(r, 1)
  Next r
  MsgBox "Code took " & Format(Timer - t, "0.000 secs")
End Sub

Sub NotLoadingArray()
  Dim t As Single
  Dim x As String
  Dim r As Long
  
  t = Timer
  For r = 1 To 1000000
    x = Cells(r, "A").Value
  Next r
  MsgBox "Code took " & Format(Timer - t, "0.000 secs")
End Sub

If you meant something else, please clarify.

I thought it must be possible to have the table in Excel itself and to let the code refer that table, instead of having it "inline" with the code.

 

[Peter_SSs]

I thought it must be possible to have the table in Excel itself and to let the code refer that table, instead of having it "inline" with the code.

As I demonstrated in my previous post, it can be done either way. If the table is small and/or you know speed isn't going to be an issue there's no problem just referring to the worksheet table.

This OP said they had "thousands of rows" so speed could become an issue. If the "thousands" is 1 or 2 thousand, probably not much of an issue but if "thousands" means 30,000 or 600,000 then it will. Given that it is just as easy to read the table into memory and manipulate it there I'm becoming more and more inclined to do so.