Using VBA to compare for matched and missing data

[detweiler]

Not being a coder, I found what I would think to be a pretty simple example of code on the Microsoft support site that compares data in two columns to find duplicates but puts the matching data in the column to the immediate right of the selected column.

Cool, but not quite what I need. I was able to tweak the code to include selecting the column data and am ( looking for ) needing help is tweaking the loop that puts the matching data in the column to the immediate right,

For Each x In Selection For Each y In CompareRange
If x = y Then x.Offset(0, 1) = x
Next y
Next x

What I am looking to modify is the If x = y Then... line to do two things,

• If x = y, Then Offset(0, 1) = "x" - - place an actual x in the cell to the right, or
• If x <> y, Then Offset(0, 1) = "missing" - - place missing in the cell to the right.

I have tried -

• If x = y Then x.Offset(0, 1) = "x" Else x.Offset(0, 1) = "missing", and
• If x = y Then x.Offset(0, 1) = "x"
  ElseIf If x <> y Then x.Offset(0, 1) = "missing"

​and have received compile errors about having an else without an if. Some of the examples I found on this were not as helpful on figuring out why I was getting the error as had hoped.

Any suggestions of thoughts on how to get this to work is appreciated.

Thanks.

 

[Fluff]

What is your "CompareRange"?

 

[detweiler]

Sorry, didn't imagine this would be a factor.

For full disclosure, I'm working with 7 worksheets in a single workbook, with worksheet 1 being the complete list and worksheets 2 -7 being the buckets I'm comparing against.

The tweak I did to select the column for each of the compare macros is -

Worksheets("Sheet1").Range("A2.A650").Select

And ranges I am comparing against for worksheets 2 -7 is -

Set CompareRange = Worksheets("Sheet2").Range("B2:B200")

Hope this is of some assistance.

 

[Fluff]

Ok, try

Sub FindMissing()
   Dim Mws As Worksheet, Ws As Worksheet
   Dim Cl As Range
   
   Set Mws = Sheets("Sheet1")
   With CreateObject("scripting.dictionary")
      For Each Ws In Worksheets
         If Not Ws Is Mws Then
            For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
               .Item(Cl.Value) = Empty
            Next Cl
         End If
      Next Ws
      For Each Cl In Mws.Range("A2", Mws.Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then Cl.Offset(, 1) = "x" Else Cl.Offset(, 1) = "missing"
      Next Cl
   End With
End Sub

 

[detweiler]

WOW! That definitely works, and seems to run quicker than the cited Microsoft support example . Where's your favorite watering hole, because the first few are on me.


If I may, and feel guilty for it because it seems as though the question I want to ask is going to ruin the worksheet range line, but...Can the application of the x and missing labels be applied in columns on sheet1 that are specific to each of the worksheet lists based on bucket names? For example,

• sheet2 = request
• sheet3 = modMade
• sheet4 = issue
• sheet5 = research
• sheet6 = assistant
• sheet7 = task

Instead of having the single 650+ cell list that will grow, I could see from which bucket the field originated from.

 

[Fluff]

Will the values in col A of sheet1 appear on only one other sheet, or multiple sheets?
If they only appear on 1 other sheet, are you happy to just have the sheet name in col B and if the value is missing then Col B will be blank?

 

[detweiler]

Will the values in col A of sheet1 appear on only one other sheet, or multiple sheets?

Sheet1 is the only sheet these values appear on.​

If they only appear on 1 other sheet, are you happy to just have the sheet name in col B and if the value is missing then Col B will be blank?

Apologies should my response not have any bearing on the question asked, but the thought was columns B - G on sheet1 be labeled with the bucket names and the cells corresponding with the value under the bucket column header would be indicated with the x or missing text, e.g.,

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]completeList[/TD]
[TD]request[/TD]
[TD]modMade[/TD]
[TD]issue[/TD]
[TD]research[/TD]
[/TR]
[TR]
[TD]value01[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]value02[/TD]
[TD]missing[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]value03[/TD]
[TD][/TD]
[TD][/TD]
[TD]missing[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]value04[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[/TR]
</tbody>[/TABLE]

​

 

[Fluff]

This won't add the "missing", but it will add the "x" for if the value exists in one of the sheets

Sub FindMissing()
   Dim Mws As Worksheet, Ws As Worksheet
   Dim Cl As Range
   Dim Ary As Variant
   Dim r As Long, c As Long
   
   Set Mws = Sheets("Sheet1")
   Ary = Mws.Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(, 7)).Value2
   c = 1
   With CreateObject("scripting.dictionary")
      For r = 2 To UBound(Ary)
         .Item(Ary(r, 1)) = r
      Next r
      For Each Ws In Worksheets
         If Not Ws Is Mws Then
            c = c + 1
            For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
               If .Exists(Cl.Value) Then Ary(.Item(Cl.Value), c) = "x"
            Next Cl
         End If
      Next Ws
   End With
   Mws.Range("A1").Resize(UBound(Ary), 8).Value = Ary
End Sub

 

[detweiler]

Fluff,

And just like, fast forward three months and it's February. Sorry I never got around to saying excellent post and thank you for your help.


tjd!

 

[Fluff]

Better late than never
You're welcome & thanks for the feedback