Sum values in cells based on a text in another cell

[lunatu]

Hi,

Im copying rows from workbook1 to workbook2 with the code below. Now I would like to modify the code so that if there is Group name in cell B, it would sum all those customers premium who are part of that group. For example like in the picture below.

Sub copysales()

Dim wb As New Workbook, rowToCopy As Integer
Dim lRow As Integer, nRow As Integer, rowno As Integer, colno As Integer

Set wb = Workbooks("Workbook2.xlsx")
lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

nRow = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

rowToCopy = nRow
Application.ScreenUpdating = True
For rowno = 2 To lRow

If (ThisWorkbook.Sheets("Sheet1").Range("F" & rowno) = Won Then
For colno = 3 To 5
If ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno) > 0 Then
ThisWorkbook.Sheets("Sheet1").Range("A" & rowno).Copy wb.Sheets("Sales").Range("A" & rowToCopy) 'To copy customer name
ThisWorkbook.Sheets("Sheet1").Cells(1, colno).Copy wb.Sheets("Sales").Range("B" & rowToCopy) 'To copy product name
ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno).Copy
wb.Sheets("Sheet1").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium
rowToCopy = rowToCopy + 1

End If
Next
End If
Next
End Sub

Any ideas how to modify the code?

 

[Peter_SSs]

Im copying rows from workbook1 to workbook2 with the code below.

I don't think that you are actually using the code posted as it contains an invalid code line.
However, in (a copy of ) your workbook, try making this change

wb.Sheets("Sheet1").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium
wb.Sheets("Sales").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium

 

[lunatu]

I don't think that you are actually using the code posted as it contains an invalid code line.
However, in (a copy of ) your workbook, try making this change

wb.Sheets("Sheet1").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium
wb.Sheets("Sales").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium

Ohe yes, there is a typo Thanks for spotting it, below corrected code:

Sub copysales()

Dim wb As New Workbook, rowToCopy As Integer
Dim lRow As Integer, nRow As Integer, rowno As Integer, colno As Integer

Set wb = Workbooks("Workbook2.xlsx")
lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

nRow = wb.Sheets("Sales").Cells(Rows.Count, 1).End(xlUp).Row + 1

rowToCopy = nRow
Application.ScreenUpdating = True
For rowno = 2 To lRow

If (ThisWorkbook.Sheets("Sheet1").Range("F" & rowno) = Won Then
For colno = 3 To 5
If ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno) > 0 Then
ThisWorkbook.Sheets("Sheet1").Range("A" & rowno).Copy wb.Sheets("Sales").Range("A" & rowToCopy) 'To copy customer name
ThisWorkbook.Sheets("Sheet1").Cells(1, colno).Copy wb.Sheets("Sales").Range("B" & rowToCopy) 'To copy product name
ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno).Copy
wb.Sheets("Sales").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium
rowToCopy = rowToCopy + 1

End If
Next
End If
Next
End Sub

 

[Peter_SSs]

below corrected code:

I think that you may have missed my point about the code as this line is still invalid ..

If (ThisWorkbook.Sheets("Sheet1").Range("F" & rowno) = Won Then

.. but did my suggested change to the other line produce the result you wanted?

 

[lunatu]

I think that you may have missed my point about the code as this line is still invalid ..



.. but did my suggested change to the other line produce the result you wanted?

Hmmm, silly question but change do you mean? I dont see what is the difference there?

 

[Peter_SSs]

I dont see what is the difference there?

The change that I was suggesting was to change the sheet name in the code line shown from "Sheet1" to "Sales"

However, in (a copy of ) your workbook, try making this change

wb.Sheets("Sheet1").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium
wb.Sheets("Sales").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium

The invalid line that I was referring to, which is a separate issue, was this one:

• It has three opening parentheses and only two closing parentheses.
• I also believe that Won near the end of the line should be enclose in quote marks: "Won"

 

[lunatu]

The change that I was suggesting was to change the sheet name in the code line shown from "Sheet1" to "Sales"



The invalid line that I was referring to, which is a separate issue, was this one:
View attachment 55209

• It has three opening parentheses and only two closing parentheses.
• I also believe that Won near the end of the line should be enclose in quote marks: "Won"

I see, thanks (maybe instead of writing the code straight in here should copy it from the macro...?‍). Below corrected code. But my original question is still open.

Sub copysales()

Dim wb As New Workbook, rowToCopy As Integer
Dim lRow As Integer, nRow As Integer, rowno As Integer, colno As Integer

Set wb = Workbooks("Workbook2.xlsx")
lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

nRow = wb.Sheets("Sales").Cells(Rows.Count, 1).End(xlUp).Row + 1

rowToCopy = nRow
Application.ScreenUpdating = True
For rowno = 2 To lRow

If ThisWorkbook.Sheets("Sheet1").Range("F" & rowno) = "Won" Then
For colno = 3 To 5
If ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno) > 0 Then
ThisWorkbook.Sheets("Sheet1").Range("A" & rowno).Copy wb.Sheets("Sales").Range("A" & rowToCopy) 'To copy customer name
ThisWorkbook.Sheets("Sheet1").Cells(1, colno).Copy wb.Sheets("Sales").Range("B" & rowToCopy) 'To copy product name
ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno).Copy
wb.Sheets("Sales").Range("C" & rowToCopy).PasteSpecial xlPasteValues 'To copy premium
rowToCopy = rowToCopy + 1

End If
Next
End If
Next
End Sub

 

[Peter_SSs]

But my original question is still open.

In Workbook 2, why are the first 3 "Customer names" actually "Group names"?

 

[lunatu]

In Workbook 2, why are the first 3 "Customer names" actually "Group names"?

If there is a Group Name in column B, I want the Group name to copied not the individual customers names. But if the Group Name cell is empty I want to copy the customer name from column A.

 

[Peter_SSs]

In the results, why is the premium for Group 1, Product 2 1000 and not 2000 per the highlighted values below?