Use conditional statement to sum column values and paste to new worksheet

[cwb1021]

Good Morning Experts,

In the worksheet below, I am attempting to sum the values in columns B,C & D if the values in column A are identical. I would like to then paste these values for each occurrence of the value in column A in a new worksheet. The values in column A will be a very long list, and should not be set as variable, i.e. Dim "1st value in column A" = x, "2nd value in column A" = y etc...

So, Im trying to loop through column A, if A3 = A2, then sum the values in columns B,C & D for the same rows and paste the result in a new work sheet. I'm likely not explaining this as well as I could, so I've pasted in the data set, and desired results below:

Data Set

DataSet.jpg

Desired Result

Desired Result.jpg

Below is where I am at right now. The code is incomplete and needs a lot of work! I've also attached the workbook.

Sub TestSum()
   Dim wsS1 As Worksheet, wsS2 As Worksheet
   Dim NameCol As Range, Dist As Range, Dhrs As Range, BHrs As Range, NameCell As Range
   Dim i As Variant
   Dim j As Long, k As Long, l As Long
   Set NameCol = Application.Intersect(wsS1.Columns(1), wsS1.UsedRange)
   i = 0
   j = 0
   k = 0
   l = 0
      For Each NameCell In NameCol
         i = i + 1
            If NameCell.Value = NameCell.Offset(-1, 0).Value Then
               NameCell.Offset(0, 1) = j
               j = j + 1
               wsS2.Cells(Rows.Count, 2).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
         
               NameCell.Offset(0, 2) = k
               k = k + 1
               wsS2.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
         
               NameCell.Offset(0, 3) = l
               l = l + 1
               wsS2.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
            End If
   
      Next NameCell
End Sub

Any help is greatly appreciated!

Thanks,

Chris

[mikerickson]

I think this will do what you want

Sub test()
    Dim SourceRange As Range
    Dim DestinationRange As Range
    Dim i As Long
    Dim strForm0 As String
    
    Set DestinationRange = Sheet3.Range("a1"): Rem adjust
    
    With Sheet1.Range("A:A")
        Set SourceRange = Range(.Cells(1, 4), .Cells(Rows.Count, 1).End(xlUp))
    End With
    
    Set DestinationRange = DestinationRange.Resize(SourceRange.Rows.Count, 4)
    
    With DestinationRange
        With .Offset(0, .Columns.Count + 1)
            .Value = SourceRange.Value
            strForm0 = "=SUMIF(" & SourceRange.Columns(1).Address(True, True, xlR1C1, True) & ", RC[-"
            For i = 2 To 4
                .Cells(1, i).Value = "Sum " & .Cells(1, i).Value
                With .Offset(1, 0).Resize(.Rows.Count - 1, 4)
                    .Columns(i).FormulaR1C1 = strForm0 & (i - 1) & "], " & SourceRange.Columns(i).Address(True, True, xlR1C1, True) & ")"
                End With
            Next i
            .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=DestinationRange.Rows(1), Unique:=True
            .ClearContents
        End With
        
    End With
End Sub

[cwb1021]

Thanks for such a quick reply Mike! I'll try it out and post the results.

thanks,

Chris

[offthelip]

You could try this which I have just tried using a completely different method, note: I don't use option explicit

[vba]Sub newtest()
Dim cclastrow As Integer
cclastrow = Worksheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Worksheets("sheet1").Select
inarr = Range(Cells(1, 1), Cells(cclastrow, 4))
outarr = Range(Cells(1, 1), Cells(cclastrow, 4))


For i = 2 To cclastrow - 1
cnt = 0
For j = i + 1 To cclastrow

If inarr(i, 1) = inarr(j, 1) Then
For m = 0 To 2
outarr(i, 2 + m) = outarr(i, 2 + m) + outarr(j, 2 + m)

Next m
cnt = cnt + 1
Else
Exit For
End If
Next j
If cnt > 0 Then
For k = 1 To cnt
For m = 0 To 2
outarr(i + k, 2 + m) = outarr(i, 2 + m)
Next m
Next k

End If
i = i + cnt
Next i
Worksheets("sheet2").Select
Range(Cells(1, 1), Cells(cclastrow, 4)) = outarr



End Sub


[/vba]

[rlv]

I learned a new trick today. Nice.

.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=DestinationRange.Rows(1), Unique:=True

[cwb1021]

All,

Thanks so much for the help. I've ended up going with the solution provided by mikerickson. But, in trying to make my question as clear as possible, I think I have oversimplified what I am trying to do, which is completely my fault.

Below is a better representation of my workbook. The columns are not in order and there are other columns in between. I've highlighted the same columns of interest. I'm still hoping to get the same result as before, but to also add one column showing the count of the data points in the sum calculations.
NewSumTest.jpgDesired Result.jpg

Again, sorry for the confusion. Any help is appreciated!

Thanks,

Chris

[mikerickson]

My method is
1) Duplicate the data to a new location.
2) Replace the data with SUMIF formulas that refer back to the original data range
3) AdvanceFilter to remove duplicated lines.

That method might work with the changes.
But, what do you want with the Not Included columns.

Name NotIncluded Sum
AAA xyz 1
AAA xyz 2
AAA abc 1
BBB lkj 5

Do you want the result to have 3 lines
AAA xyz 3
AAA abx 1
BBB lkj 5

or two lines
AAA ??? 4
BBB lkj 5

To put it another way, do the Not Included columns count when determining what a duplicate row is?

[offthelip]

Hi Mike,
Does your solution cater for the case when there are three identical values in column A?

[cwb1021]

Mikerickson,

If I understand your question correctly, only the name column (column Q in NewSumTest workbook) would determine if a row is a duplicate in the worksheet (Sheet3) the data is pasted to. I would not consider any of the data in the unused columns.

Does that answer the question?

Thanks,

Chris

[offthelip]

Mkerickson:
I made the assumption that if there three rows with identical values ( ie rows 23,24,25) in the original post, I assumed that the sum of all three is entered into all three rows. I can't see how your solution sums up more than two rows. I am not sure I fully understand what you are doing. I know that my solution will add up any number of rows with the same value

[mikerickson]

It sounds like my method will work for your situation. But I'm still not clear what you want done with the "irrelevant columns".
Do you want them eliminated from the result?

Is the data in the irrelevant columns for all rows of a name the same or does it vary?

Could you mock up a Before and After workbook that has a few irrelevant columns and attach it?

[cwb1021]

Mikerickson,

Yes, the irrelevant columns should be eliminated from the result. There is data for every row that or the worksheet, even in the irrelevant columns. So, there will not be any blank cells in the used portion of the worksheet.

Below here is the data set. Originally, only the columns highlighted in blue were in the data set, allowing your code to scroll from left to right through the columns, summing the values. So what I'm hoping to do with this data set, is to get the same result as before. This time however, the columns we need are separated by other columns of irrelevant data that must be excluded from the result.

Original Data Set.jpg


Here is the "after" result:

Desired Result.jpg

This is identical to the result your first code gave, but with 1 additional column which gives the number of data points that were used in the summed results. I've attached this workbook as well.

Does that answer your question? Please let me know if there is additional information I can provide.

Thanks,

Chris

[mikerickson]

At the end of my posted solution, just add some code to delete the irrelevant columns.