How to compare rows in excel (vba) and insert an other column? - excel

Question

I need something like this.
This picture contains all what I need, I need to insert Automatically the Value column.
I'll start by sorting rows, to help me to affect the same value to the same rows.
And I need to compare row by row (row to the next) if are the same i'll affect them the same value(column value).
Sub SortMultipleColumns()
// I'll start by sorting rows, to help me to affect the same value to the same rows
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1"), Order:=xlAscending
.SortFields.Add Key:=Range("B1"), Order:=xlAscending
.SortFields.Add Key:=Range("C1"), Order:=xlAscending
.SortFields.Add Key:=Range("D1"), Order:=xlAscending
.SetRange Range("A1", Range("D1").End(xlDown))
.Header = xlYes
.Apply
End With
Dim bothrows As Range, i As Integer
Set bothrows = Selection
With bothrows
// here i need to compre rows and insert in the last column value start by 1++
For i = 1 To .Rows.Count
If Not StrComp(.Cells(1, i), .Cells(2, i), vbBinaryCompare) = 0 Then
// here I need to do something
End If
Next i
End With
End Sub

Answer 1

Try this code:
Sub SortMultipleColumns()
'Declarations.
Dim RngList As Range
Dim RngRow As Range
Dim RngCell As Range
Dim DblCounter As Double
Dim StrString01 As String
Dim StrString02 As String
'Setting RngList.
Set RngList = Range("A1")
Set RngList = Range(RngList, RngList.End(xlDown).End(xlToRight))
Set RngList = RngList.Resize(RngList.Rows.Count - 1).Offset(1, 0)
'Sorting RngList.
With ActiveSheet.Sort
.SortFields.Clear
For Each RngCell In RngList.Rows(1).Cells
.SortFields.Add Key:=RngCell, Order:=xlAscending
Next
.SetRange RngList
.Header = xlYes
.Apply
End With
'Covering each row of RngList.
For Each RngRow In RngList.Rows
'Setting variables.
StrString01 = ""
StrString02 = ""
'Covering each cell in the given row.
For Each RngCell In RngRow.Cells
'Setting variables to the contents of the given row and to its previous one.
StrString01 = StrString01 & RngCell.Value
StrString02 = StrString02 & RngCell.Offset(-1, 0).Value
Next
'Checking if the two rows differs.
If Not StrComp(StrString01, StrString02, vbBinaryCompare) = 0 Then
DblCounter = DblCounter + 1
End If
'Reporting DblCounter.
RngRow.Offset(0, RngRow.Columns.Count).Resize(1, 1) = DblCounter
Next
End Sub
Since it adapts to the width of the given list, it's meant to be used once on the list. You can just edit the setting of RngList to a list with a fixed number of column if you want to use it multiple times. Like this:
'Setting RngList.
Set RngList = Range("A1")
Set RngList = Range(RngList, RngList.End(xlDown).Offset(0,3)
Set RngList = RngList.Resize(RngList.Rows.Count - 1).Offset(1, 0)
You can also use a formula to obtain the same result. Something like this in cell E2 should do the trick:
=IF(A2&B2&C2&D2=A1&B1&C1&D1,MAX(E$1:E1),MAX(E$1:E1)+1)