Excel VBA: How to compare values of two cells?

[a098p]

I am trying to compare the values in two columns for consecutive rows. Specifically, I would like to check the value under Column B and Column C of each row with the one directly above it. And if it matches, perform some XYZ action.

I have the code below which I tried to use but it keeps throwing up errors.


<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub SortAndMergeDupes()

With ActiveSheet

Dim lngRow As Long
Dim ws As Worksheet
Dim columnToMatch As Integer: columnToMatch =2
Dim column2ToMatch As Integer: column2ToMatch =3

Set ws = ThisWorkbook("Sheet1")
Set lngRow =.Cells(65536, columnToMatch).End(xlUp).Row

Do

If ws.Cells(lngRow, columnToMatch).Value = ws.Cells(lngRow -1, columnToMatch).Value And Cells(lngRow, column2ToMatch).Value = Cells(lngRow -1, column2ToMatch).Value Then


For i =4 To 50

If.Cells(lngRow -1, i).Value ="" Then
.Cells(lngRow -1, i).Value =.Cells(lngRow, i).Value

End If

Next i

.Rows(lngRow).Delete

End If

lngRow = lngRow -1

Loop Until lngRow =1

End With

End Sub


</code>Specifically, the error shows up in this line: (Usually - Error method of '_Default' if Object Range failed)
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">If ws.Cells(lngRow, columnToMatch).Value = ws.Cells(lngRow -1, columnToMatch).Value And Cells(lngRow, column2ToMatch).Value = Cells(lngRow -1, column2ToMatch).Value Then

</code>And now, as well as:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">If.Cells(lngRow -1, i).Value ="" Then
.Cells(lngRow -1, i).Value =.Cells(lngRow, i).Value

End If

</code>Any pointers?

 

[Fluff]

Ok, how about

Sub SortAndMergeDupes()

   Dim i As Long
   Dim Cl As Range, Rng As Range
   Application.ScreenUpdating = False
   With Sheets("Pcode")
      For i = .Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
         If .Range("B" & i) = .Range("B" & i - 1) And .Range("C" & i) = .Range("C" & i - 1) Then
            For Each Cl In .Range("D" & i - 1).Resize(, 47).SpecialCells(xlBlanks).Areas
               Cl.Value = Cl.Offset(1).Value
               If Rng Is Nothing Then Set Rng = .Rows(i) Else Set Rng = Union(Rng, .Rows(i))
            Next Cl
         End If
      Next i
      If Not Rng Is Nothing Then Rng.Delete
   End With
End Sub

 

[a098p]

Ok, how about

Sub SortAndMergeDupes()

   Dim i As Long
   Dim Cl As Range, Rng As Range
   Application.ScreenUpdating = False
   With Sheets("Pcode")
      For i = .Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
         If .Range("B" & i) = .Range("B" & i - 1) And .Range("C" & i) = .Range("C" & i - 1) Then
            For Each Cl In .Range("D" & i - 1).Resize(, 47).SpecialCells(xlBlanks).Areas
               Cl.Value = Cl.Offset(1).Value
               If Rng Is Nothing Then Set Rng = .Rows(i) Else Set Rng = Union(Rng, .Rows(i))
            Next Cl
         End If
      Next i
      If Not Rng Is Nothing Then Rng.Delete
   End With
End Sub

This works well - thanks!

 

[Fluff]

You're welcome & thanks for the feedback