CODEWITHSUNDEEP
excelvba
mrGott
mrGott

Reputation: 1076

Find similar values in multiple columns, sum and get range

I've been trying to solve this issue for a week but couldn't find the right way to do so.

enter image description here

As shown on the image above, I have a list of data. Column A is a group identifier, Column B is sub group and then we have percentages in Column C.

My goal is to find A: 1117, loop in 'theSameTitle', sum up percentages and if they exceed 10%, I'll display total percentage or some text in column D. The thing is that I also want to merge corresponding rows along the "summed block". In case of 1117:theSametitle I would merge 3 rows in column D. This "merge" is for reporting purposes.

So far I can find 1117:theSameTitle and sum it, but can't figure out how to detect which rows are involved to merge them. Here's the code I came up with:

Sub determinePercentages()

     ' Select cell A1, *first line of data*.
      Range("A1").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.

         nextCell = ActiveCell.Offset(1, 0).Value
         'nextCell2 = ActiveCell.Offset(1, 3).Value

         If Range("C" & ActiveCell.Row) > 0.1 Then
            'MsgBox (Range("C" & ActiveCell.Row).Value)
            Range("E" & ActiveCell.Row).Value = "YES"
         End If

         'If ActiveCell & ActiveCell.Offset(0, 3) <> nextCell & nextCell2 Then
           curSumIfs = Application.WorksheetFunction.SumIfs(Range("C:C"), Range("A:A"), ActiveCell.Value, Range("B:B"), ActiveCell.Offset(0, 3).Value)
           If curSumIfs >= 0.1 Then
              ActiveCell.Offset(0, 10).Value = curSumIfs
           End If
         'End If

         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop

End Sub

I'm also fairly new to VBA and Excel. I don't know how efficient my code is. Maybe there's a much better way to implement it.

I need your help :)

Upvotes: 0

Views: 74

Answers (1)

BigBen
BigBen

Reputation: 50008

One approach is to "merge" as you go, comparing the current row (both columns A and B) to the previous row, and if the same then merging the current row with the previous row's MergeArea in column D.

Code demonstrating just the merge (I'll leave you to incorporate the "YES" and "Sumifs")

Sub DeterminePercentages()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    With ws
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        Dim i As Long
        For i = 2 To lastRow
            If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
                If .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then
                    .Range(.Cells(i, 4), .Cells(i - 1, 4).MergeArea).Merge
                End If
            End If
        Next
    End With
End Sub

enter image description here

Upvotes: 1

Related Questions