Combine 2 Macros into 1

[boldcode]

Hello,

I needed some help in combing the 2 following Macros into 1:

I need the "UpdateDataset" Macro to run first:

Option Explicit
Sub UpdateDataset()
Dim wS As Worksheet, wL As Worksheet
Dim c As Range, FR As Long
Application.ScreenUpdating = False
Set wS = ActiveWorkbook.ActiveSheet
Set wL = Worksheets("WBSList")
For Each c In wS.Range("D2", wS.Range("D" & Rows.Count).End(xlUp))
If c <> "" Then
FR = 0
On Error Resume Next
FR = Application.Match(c, wL.Columns(1), 0)
On Error GoTo 0
If FR > 0 Then
c.Offset(, 1).Resize(, 3).Value = wL.Range("B" & FR).Resize(, 3).Value
End If
End If
Next c
Application.ScreenUpdating = True
End Sub

After the "UpdateDataset" VBA code goes first then I need the "Sum_On_2_Criteria" Macro to go Second:

Option Explicit
Sub Sum_On_2_Criteria()
Dim a As New Collection, main As Worksheet, x, y, i As Long, j As Long, temp As String, m As Long, n As Long
Application.ScreenUpdating = False: Set main = ActiveWorkbook.ActiveSheet
With main: x = .Range(.[a2], .Cells(Rows.Count, "a").End(xlUp).Offset(, 7)): ReDim y(1 To UBound(x), 1 To UBound(x, 2)): On Error Resume Next
For i = 1 To UBound(x)
j = j + 1: temp = x(i, 3) & x(i, 4) & x(i, 5) & x(i, 6) & x(i, 7): a.Add j, temp
If Err.Number = 0 Then
n = n + 1
Do
m = m + 1: y(n, m) = x(i, m)
Loop Until m = 8: m = 0
Else
j = j - 1: y(a.Item(temp), 8) = y(a.Item(temp), 8) + x(i, 8): Err.Clear
End If: Next: Sheets.Add: With ActiveSheet: main.[a1:h1].Copy .[a1:h1]
With .[a2].Resize(j, UBound(y, 2)): .Value = y: .Borders.LineStyle = xlContinuous: .EntireColumn.AutoFit: End With
End With: End With: Application.ScreenUpdating = True: End Sub

I want to combine these two Macros together into one Macro with the "UpdateDataset" VBA code to run first and then the "Sum_On_2_Criteria" VBA code to run right after the "UpdateDataset" VBA code has ran successfully.

Thanks

 

[mouse88]

Can't you just call the second subroutine at the end of your first subroutine.

Sub UpdateDataset()
Dim wS As Worksheet, wL As Worksheet
Dim c As Range, FR As Long
Application.ScreenUpdating = False
Set wS = ActiveWorkbook.ActiveSheet
Set wL = Worksheets("WBSList")
For Each c In wS.Range("D2", wS.Range("D" & Rows.Count).End(xlUp))
If c <> "" Then
FR = 0
On Error Resume Next
FR = Application.Match(c, wL.Columns(1), 0)
On Error GoTo 0
If FR > 0 Then
c.Offset(, 1).Resize(, 3).Value = wL.Range("B" & FR).Resize(, 3).Value
End If
End If
Next c
Application.ScreenUpdating = True
 
[COLOR=red][B]Call Sum_On_2_Criteria[/B][/COLOR]
 
End Sub

This way if you assign UpdateDataset() to a button it will automatically run the second sub routine for you.

 

[boldcode]

mouse88,

Thank you that worked out nicely. I don't if anyone has a different option, but this seems to work

 

[mouse88]

No problem.

You only have two options either the one I gave above or to just add all of the code from your second sub to the end of the first sub.

 

[boldcode]

mouse88,

What if I want to call 2 subroutines?

 

[boldcode]

mouse88,

I don't this solution will work if I convert this combined macro into an excel add-in though. What do you think?

 

[JPWRana]

.