Excel - SUM with condition vba

N

ngocanh87

Board Regular
Joined
Mar 16, 2016
Messages
85
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I have code add col&format but how i can Sum yellow line = SUM(white line same code at colA) and paste Sum same Code (Sheet2)
Sheet1.jpg
to Sheet2
Thank
Sub Reclass()
Dim LastRow As Long

Sheets("DETAIL (CHI TIET)").Select
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If

Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Columns("P:P").Insert
Range("P9") = "Lai Chiem Dung_Overdue Interest"
Range(Cells(10, 16), Cells(LastRow, 16)).FormulaR1C1 = "=IF(LEFT(RC[-14],2)=""C0"",(Sheet1!R2C6/365)*RC[-3]*RC[-2],(Sheet1!R3C6/365)*RC[-3]*RC[-2])"

Range("J:J").Copy
Range("P:P").PasteSpecial xlFormats

Application.ScreenUpdating = True

End Sub
Click to expand...
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Sort by date Sort by votes
If you would consider a formula approach rather than VBA, the following gives you what you seem to be looking for. For demonstration purposes, I put the summary on the same sheet, but you can easily point the formulas to another sheet (and extend the ranges as far as you need them).

Cars.xlsb
ABCDEFGH
8
9CodeNameOverdueCodeNameOverdue
10C10010TEST$ 100.00C10010TEST$ 327.00
11C10010TEST$ 200.00C10101TEST$ 150.00
12C10010TEST$ 15.00C10252TEST$ 280.00
13C10010TEST$ 12.00
14C10010TEST$ 327.00
15C10101TEST$ 150.00
16C10101TEST$ 150.00
17C10252TEST$ 10.00
18C10252TEST$ 20.00
19C10252TEST$ 30.00
20C10252TEST$ 40.00
21C10252TEST$ 50.00
22C10252TEST$ 60.00
23C10252TEST$ 70.00
24C10252TEST$ 280.00
25
Sheet1
Cell Formulas
RangeFormula
G10:G12G10=SUMIF($A$10:$A$24,E10,$C$10:$C$24)-MAX(IF($A$10:$A$24=E10,$C$10:$C$24))
C14C14=SUM(C10:C13)
C16C16=SUM(C15)
C24C24=SUM(C17:C23)
 
Upvote 0
In hindsight, a simpler formula would probably do the trick?

Cars.xlsb
ABCDEFGH
8
9CodeNameOverdueCodeNameOverdue
10C10010TEST$ 100.00C10010TEST$ 327.00
11C10010TEST$ 200.00C10101TEST$ 150.00
12C10010TEST$ 15.00C10252TEST$ 280.00
13C10010TEST$ 12.00
14C10010TEST$ 327.00
15C10101TEST$ 150.00
16C10101TEST$ 150.00
17C10252TEST$ 10.00
18C10252TEST$ 20.00
19C10252TEST$ 30.00
20C10252TEST$ 40.00
21C10252TEST$ 50.00
22C10252TEST$ 60.00
23C10252TEST$ 70.00
24C10252TEST$ 280.00
25
Sheet1
Cell Formulas
RangeFormula
G10:G12G10=MAX(IF($A$10:$A$24=E10,$C$10:$C$24))
C14C14=SUM(C10:C13)
C16C16=SUM(C15)
C24C24=SUM(C17:C23)
 
Upvote 0
Thank you for your support but this is an automatic excel file, the file will change every day, so is there a way to automatically use vba to insert them?
 
Upvote 0
OK. It's very difficult to help based purely on a screenshot, which clearly shows a large number of hidden columns. We have no idea what those columns contain. I've written the following code using a large number of assumptions - it's unlikely that it will be right first time. Please note that if the code needs adjusting, then I'll need to see your actual data before I can help any further. You can disguise anything confidential. Use the XL2BB Tool to help us to help you. I'm assuming that you want the total rows added on Sheet1 as part of the process.

VBA Code: 
Option Explicit
Sub ngocanh87()
    Dim ws1 As Worksheet, ws2 As Worksheet, lr As Long
    Set ws1 = Sheets("DETAIL (CHI TIET)")
    Set ws2 = Sheets("Sheet2")
    
    Application.ScreenUpdating = True
    
    'Clear any existing data from Sheet2
    lr = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If lr > 9 Then ws2.Rows("10:" & lr).ClearContents
    
    'Put formulas/formats in Sheet1(& formats in Sheet2)
    With ws1
        .AutoFilterMode = False
        lr = ws1.Cells(Rows.Count, 1).End(3).Row
        .Columns("P:P").Insert
        .Columns("J:J").Copy
        .Columns("P:P").PasteSpecial xlPasteFormats
            ws2.Columns("P:P").PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        .Range("P9") = "Lai Chiem Dung_Overdue Interest"
        .Range("P10:P" & lr).FormulaR1C1 = _
                "=IF(RC2=""C0*"",R2C6/365*RC13*RC14,R3C6/365*RC13*RC14)"
        .Range("P10:P" & lr).Value = .Range("P10:P" & lr).Value
    End With
    
    'Put SUM values into Sheet2
    Dim ar, i As Long, k As Variant
    ar = ws1.Range("A10:A" & lr)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            .Item(ar(i, 1)) = .Item(ar(i, 1))
        Next
        ar = Array(.keys)
        ws2.Range("A10").Resize(.Count, 1) = Application.Transpose(ar)
    End With
    
    lr = ws2.Cells(Rows.Count, 1).End(3).Row
    With ws2.Range("P10:P" & lr)
        .FormulaR1C1 = "=SUMIF('DETAIL (CHI TIET)'!C1, RC1 , 'DETAIL (CHI TIET)'!C16)"
        .Value = .Value
    End With
    
    'Add Totals rows to Sheet1
    lr = ws1.Cells(Rows.Count, 1).End(3).Row
    With ws1
    For i = lr + 1 To 11 Step -1
        If ws1.Cells(i, 1) <> ws1.Cells(i - 1, 1) Then
            ws1.Cells(i, 1).EntireRow.Insert
            ws1.Cells(i, 1).EntireRow.Font.Bold = True
            ws1.Cells(i, 1) = ws1.Cells(i - 1, 1)
            ws1.Cells(i, 16).Value = Application.SumIf(ws1.Cells(10, 1).Resize(i), ws1.Cells(i, 1), ws1.Cells(10, 16).Resize(i))
        End If
    Next i
    End With
    ws1.Range("P1").EntireColumn.Hidden = False
    ws2.Range("P1").EntireColumn.Hidden = False
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
kevin9999 said:
OK. It's very difficult to help based purely on a screenshot, which clearly shows a large number of hidden columns. We have no idea what those columns contain. I've written the following code using a large number of assumptions - it's unlikely that it will be right first time. Please note that if the code needs adjusting, then I'll need to see your actual data before I can help any further. You can disguise anything confidential. Use the XL2BB Tool to help us to help you. I'm assuming that you want the total rows added on Sheet1 as part of the process.

VBA Code: 
Option Explicit
Sub ngocanh87()
    Dim ws1 As Worksheet, ws2 As Worksheet, lr As Long
    Set ws1 = Sheets("DETAIL (CHI TIET)")
    Set ws2 = Sheets("Sheet2")
   
    Application.ScreenUpdating = True
   
    'Clear any existing data from Sheet2
    lr = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If lr > 9 Then ws2.Rows("10:" & lr).ClearContents
   
    'Put formulas/formats in Sheet1(& formats in Sheet2)
    With ws1
        .AutoFilterMode = False
        lr = ws1.Cells(Rows.Count, 1).End(3).Row
        .Columns("P:P").Insert
        .Columns("J:J").Copy
        .Columns("P:P").PasteSpecial xlPasteFormats
            ws2.Columns("P:P").PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        .Range("P9") = "Lai Chiem Dung_Overdue Interest"
        .Range("P10:P" & lr).FormulaR1C1 = _
                "=IF(RC2=""C0*"",R2C6/365*RC13*RC14,R3C6/365*RC13*RC14)"
        .Range("P10:P" & lr).Value = .Range("P10:P" & lr).Value
    End With
   
    'Put SUM values into Sheet2
    Dim ar, i As Long, k As Variant
    ar = ws1.Range("A10:A" & lr)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            .Item(ar(i, 1)) = .Item(ar(i, 1))
        Next
        ar = Array(.keys)
        ws2.Range("A10").Resize(.Count, 1) = Application.Transpose(ar)
    End With
   
    lr = ws2.Cells(Rows.Count, 1).End(3).Row
    With ws2.Range("P10:P" & lr)
        .FormulaR1C1 = "=SUMIF('DETAIL (CHI TIET)'!C1, RC1 , 'DETAIL (CHI TIET)'!C16)"
        .Value = .Value
    End With
   
    'Add Totals rows to Sheet1
    lr = ws1.Cells(Rows.Count, 1).End(3).Row
    With ws1
    For i = lr + 1 To 11 Step -1
        If ws1.Cells(i, 1) <> ws1.Cells(i - 1, 1) Then
            ws1.Cells(i, 1).EntireRow.Insert
            ws1.Cells(i, 1).EntireRow.Font.Bold = True
            ws1.Cells(i, 1) = ws1.Cells(i - 1, 1)
            ws1.Cells(i, 16).Value = Application.SumIf(ws1.Cells(10, 1).Resize(i), ws1.Cells(i, 1), ws1.Cells(10, 16).Resize(i))
        End If
    Next i
    End With
    ws1.Range("P1").EntireColumn.Hidden = False
    ws2.Range("P1").EntireColumn.Hidden = False
    Application.ScreenUpdating = True

End Sub
Click to expand...
Change the first
Rich (BB code): 
Application.ScreenUpdating = True
to
Rich (BB code): 
False
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
VBA: All Sheets data to Master Sheet (excluding some sheet)
2
Replies
11
Views
517
kevin9999
K
D
  • Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
228
dilshod_k
D
B
  • Question
Calculate P-Value. Range v Array
Replies
0
Views
290
Bernieg
B
N
  • Solved
VBA Use of SUM function with variables
Replies
8
Views
824
Joe4
Joe4
T
  • Solved
Do without loop error
Replies
4
Views
544
tispivey
T

Forum statistics

Threads
1,217,270
Messages
6,135,579
Members
449,948
Latest member
AmyB2212

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top