Combining Code

[truitt20]

Currently I am running the following codes on two seperate worksheets, but would like to run both on the same wrksheet. How do you combine the two subs into one?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long, WF As WorksheetFunction
Set WF = Application.WorksheetFunction
If Not Application.Intersect(Target, Range("D")) Is Nothing Then
With Sheet2
lRow = .[A1].CurrentRegion.Rows.Count + 1
.Cells(lRow, 1) = Now
.Cells(lRow, 2) = WF.Subtotal(9, Sheet1.Range("D"))
.Cells(lRow, 3) = WF.Subtotal(9, Sheet1.Range("D")) / Sheets("Notionals").Range("B16").Value
End With
End If
Set WF = Nothing
End Sub

Private Sub Worksheet_Change1(ByVal Target As Range)
Dim lRow As Long, WF As WorksheetFunction
Set WF = Application.WorksheetFunction
If Not Application.Intersect(Target, Range("D")) Is Nothing Then
With Sheet4
lRow = .[A1].CurrentRegion.Rows.Count + 1
.Cells(lRow, 1) = Now
.Cells(lRow, 2) = WF.SumIf(Sheet1.Range("AF:AF"), "*US*", Sheet1.Range("D"))
.Cells(lRow, 3) = WF.SumIf(Sheet1.Range("AF:AF"), "*US*", Sheet1.Range("D")) / Sheets("Notionals").Range("K16").Value
End With
End If
Set WF = Nothing
End Sub

 

[firefytr]

Hi there,

Which formulas do you want to keep? You have 4 different formulas.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[truitt20]

I want to keep everything. Currently I am running into a problem when one wrksheet refreshs at a different time than worksheet 2. Since that data that is summed and exported is graphed according to time, the data points are not matching up exactly. So in essence i would like everything in the two subs to run at the same time on the same worksheet.

 

[firefytr]

Okay, but the problem is you'll overwrite your formula returns. This is because you're pointing to cells ...

.Cells(lRow, 1)
.Cells(lRow, 2)
.Cells(lRow, 3)

.. twice. Do you want the other formulas in, let's say, column 4 and 5?

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[truitt20]

i want the two seperate sums to populate different worksheets...wrkt 2 & the other sub totals on wrksht 4

 

[firefytr]

How about this ...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long, lRow2 As Long, WF As WorksheetFunction
    Set WF = Application.WorksheetFunction
    If Not Application.Intersect(Target, Range("D:D")) Is Nothing Then
        With Sheet2
            lRow = .Range("A1").CurrentRegion.Rows.Count + 1
            .Cells(lRow, 1) = Now
            .Cells(lRow, 2) = WF.Subtotal(9, Sheet1.Range("D:D"))
            .Cells(lRow, 3) = WF.Subtotal(9, Sheet1.Range("D:D")) / Sheets("Notionals").Range("B16").Value
        End With
        With Sheet4
            lRow2 = .Range("A1").CurrentRegion.Rows.Count + 1
            .Cells(lRow2, 1) = Now
            .Cells(lRow2, 2) = WF.SumIf(Sheet1.Range("AF:AF"), "*US*", Sheet1.Range("D:D"))
            .Cells(lRow2, 3) = WF.SumIf(Sheet1.Range("AF:AF"), "*US*", Sheet1.Range("D:D")) / Sheets("Notionals").Range("K16").Value
        End With
    End If
    Set WF = Nothing
End Sub

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[truitt20]

Works wonders!! thanks!

 

[truitt20]

fire,

another quick question. I am trying to sum data that does not include *japan*( "<>*JAPAN*"), but i would also like to sum the data and not include an additonal criteria - not like US ("<>*US*). how do i combine into same line in code? i would assume something like this, but this is not working

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long, lRow2 As Long, WF As WorksheetFunction
Set WF = Application.WorksheetFunction
If Not Application.Intersect(Target, Range("D")) Is Nothing Then
With Sheet2
lRow = .Range("A1").CurrentRegion.Rows.Count + 1
.Cells(lRow, 1) = Now
.Cells(lRow, 2) = WF.SumIf(Sheet1.Range("AF:AF"), "<>*JAPAN*" And "<>*US*" Sheet1.Range("D"))
.Cells(lRow, 3) = WF.SumIf(Sheet1.Range("AF:AF"), "<>*JAPAN*" And "<>*US*",Sheet1.Range("D")) / Sheets("Notionals").Range("B16").Value
End With

 

[firefytr]

No, you can't do that. You either need AutoFilter, a helper column, an array formula or a SUMPRODUCT formula. Maybe ..

.Cells(lRow, 2) = WF.SumProduct((0+WF.IsNumber(WF.Find("JAPAN",Sheet1.Range("AF:AF"))))*(0+WF.IsNumber(WF.Find("US",Sheet1.Range("AF:AF")))),Sheet1.Range("D:D"))
            .Cells(lRow, 3) = .Cells(lRow, 2) / Sheets("Notionals").Range("B16").Value

NB: untested, hand written.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci