VBA to compare each cell of 2 sets of data and give result TRUE or False

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
Dear VBA Masters

I tried to find solution within forum and manage to create code, but can not get what have i done wrong
I have two sets of data on same worksheet. Both looks similar. Have same number of rows and columns ( column headers in same order). Headers are same. Amount of rows and Headers for both is dynamic. Values for each cell in both should match, however it never does. That's why i need to have this kind of comparison.
So Set of data on left side that's values from Requirements where the middle from Extract. I want my code to compare all cells from Requirements with Extract and place value TRUE or FALSE and display them right of Extract data under correct Header.
Some of rows between Extract data contains #N/A as result of previous VLOOKUP function. I need to keep those and display comparison result as #N/A instead of FALSE
Please let me know what i am doing wrong here?
FALSE TRUE.PNG



VBA Code:
Sub CompareCells()


Dim ws As Worksheet
 Dim j As Long
  Dim i As Long
   Dim lrowR As Long
    Dim lcolR As Long
     Dim lcolE As Long
       Dim LvalueR As String
        Dim LvalueE As String
         Dim CompInput As Range
          Dim fcolE As Long
          
      Set ws = ThisWorkbook.Sheets("Comparison")
        lrowR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  ' Last row requirments
            lcolR = ws.Cells(1, 1).End(xlToRight).Column   ' Last column requirments

For j = 2 To lcolR
    For i = 2 To lrowR Step 1

LvalueR = ws.Cells(i, 1).Value     'Requirments look up value
    fcolE = lcolR + j
        LvalueE = ws.Cells(i, fcolE).Value                             'Extract lookup value
                lcolE = ws.Cells(1, lcolR + 2).End(xlToRight).Column   'Extract last column
                        CompInput = ws.Cells(i, lcolE + j)                            'Comparison result first cell
                        

If IsError(LvalueE) Then
    CompInput.Value = "#N/A"
        If LvalueR = LvalueE Then
            CompInput.Value = "True"
                Else
                   CompInput.Value = "False"
                End If
        End If
    Next i
Next j
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,816
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub radsok()
   Dim Sary As Variant, Eary As Variant, Nary As Variant
   Dim r As Long, c As Long
   
   With Range("A1").CurrentRegion
      Sary = .Value2
      Eary = .Offset(, .Columns.Count + 1).Value2
   End With
   ReDim Nary(1 To UBound(Sary), 1 To UBound(Sary, 2))
   For c = 1 To UBound(Sary, 2)
      Nary(1, c) = Sary(1, c)
   Next c
   For r = 2 To UBound(Sary)
      For c = 1 To UBound(Sary, 2)
         If IsError(Eary(r, c)) Then
            Nary(r, c) = "#N/A"
         Else
            Nary(r, c) = Sary(r, c) = Eary(r, c)
         End If
      Next c
   Next r
   Cells(1, Columns.Count).End(xlToLeft).Offset(, 2).Resize(UBound(Sary), UBound(Sary, 2)).Value = Nary
End Sub
 

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
How about
VBA Code:
Sub radsok()
   Dim Sary As Variant, Eary As Variant, Nary As Variant
   Dim r As Long, c As Long
  
   With Range("A1").CurrentRegion
      Sary = .Value2
      Eary = .Offset(, .Columns.Count + 1).Value2
   End With
   ReDim Nary(1 To UBound(Sary), 1 To UBound(Sary, 2))
   For c = 1 To UBound(Sary, 2)
      Nary(1, c) = Sary(1, c)
   Next c
   For r = 2 To UBound(Sary)
      For c = 1 To UBound(Sary, 2)
         If IsError(Eary(r, c)) Then
            Nary(r, c) = "#N/A"
         Else
            Nary(r, c) = Sary(r, c) = Eary(r, c)
         End If
      Next c
   Next r
   Cells(1, Columns.Count).End(xlToLeft).Offset(, 2).Resize(UBound(Sary), UBound(Sary, 2)).Value = Nary
End Sub
Thank You for feedback. It does not work. When I run above code nothing happens at all. No even errors
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,816
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub radsok()
   Dim Sary As Variant, Eary As Variant, Nary As Variant
   Dim r As Long, c As Long
   
   With Sheets("Comparison").Range("A1").CurrentRegion
      Sary = .Value2
      Eary = .Offset(, .Columns.Count + 1).Value2
   End With
   ReDim Nary(1 To UBound(Sary), 1 To UBound(Sary, 2))
   For c = 1 To UBound(Sary, 2)
      Nary(1, c) = Sary(1, c)
   Next c
   For r = 2 To UBound(Sary)
      For c = 1 To UBound(Sary, 2)
         If IsError(Eary(r, c)) Then
            Nary(r, c) = "#N/A"
         Else
            Nary(r, c) = Sary(r, c) = Eary(r, c)
         End If
      Next c
   Next r
   Sheets("Comparison").Cells(1, Columns.Count).End(xlToLeft).Offset(, 2).Resize(UBound(Sary), UBound(Sary, 2)).Value = Nary
End Sub
 
Solution

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
How about
VBA Code:
Sub radsok()
   Dim Sary As Variant, Eary As Variant, Nary As Variant
   Dim r As Long, c As Long
  
   With Sheets("Comparison").Range("A1").CurrentRegion
      Sary = .Value2
      Eary = .Offset(, .Columns.Count + 1).Value2
   End With
   ReDim Nary(1 To UBound(Sary), 1 To UBound(Sary, 2))
   For c = 1 To UBound(Sary, 2)
      Nary(1, c) = Sary(1, c)
   Next c
   For r = 2 To UBound(Sary)
      For c = 1 To UBound(Sary, 2)
         If IsError(Eary(r, c)) Then
            Nary(r, c) = "#N/A"
         Else
            Nary(r, c) = Sary(r, c) = Eary(r, c)
         End If
      Next c
   Next r
   Sheets("Comparison").Cells(1, Columns.Count).End(xlToLeft).Offset(, 2).Resize(UBound(Sary), UBound(Sary, 2)).Value = Nary
End Sub
Mate it works as Champion. Thank You very much. U gave me a new stuff to learn. I don't get what is happening exactly here so will study it.
Any chance you could possibly check in free time what i was doing wrong with my code ?
Anyway thanks again, what a great feedback here we can get.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,816
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,083
Messages
5,639,977
Members
417,120
Latest member
Pavithra devi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top