1

I need to combine multiple macros to a single macro that executes on button click. Kindly excuse me if I write anything wrong since I am completely new to excel macros and vb.

Following is the scenario.

Steps:

  1. Calculate total
  2. Extract reference
  3. Compare total field value for matching reference and mark that as "Complete" if sum of total for matching references calculates to ).

(Explained...) First i calculate the debit and credit amount to a new column called total, for this, initially I used the SUM function. after that I tried the same using the macro that executes on button click

(old macro)

Private Sub getTotal_Click()
    With ActiveSheet
       lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
For i = 5 To lastRow
    Range("K" & i).Value = Range("F" & i).Value + Range("G" & i).Value
Next i
End Sub

This was so much time consuming (took around 2 hrs when executed on 75k records) than when using the formula (which finished in minutes). I am still not able to understand the reason for this. However modifiying to Dy.Lee's answer below, it took only seconds to calculate the total.

(modified based on Dy.Lee's answer)

Private Sub getTotal_Click()
    Dim vDB As Variant, vR() As Variant
    Dim i As Long, n As Long, lastRow As Long

    With ActiveSheet
       lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       vDB = .Range("R5", "S" & lastRow)
       n = UBound(vDB, 1)
       ReDim vR(1 To n, 1 To 1)
       For i = 1 To n
           vR(i, 1) = vDB(i, 1) + vDB(i, 2)
       Next i
      .Range("AL5").Resize(n) = vR
    End With

End Sub

Now moving on to the second macro which I used to extract a pattern from strings in a column D and E.

Function extractReference(cid_No As String, pm_source As String)
Dim regExp As Object, findMatches As Object, match As Object
Dim init_result As String: init_result = ""

Set regExp = CreateObject("vbscript.regexp")
With regExp
    .Global = True
    .MultiLine = False
    .Pattern = "(?:^|\D)(\d{5,6})(?!\d)"
End With


Set findMatches = regExp.Execute(pm_source)
For Each match In findMatches
    init_result = init_result + match.SubMatches.Item(0)
Next

If init_result <> "" Then
    extractReference = cid_No & " | " & init_result
Else
    extractReference = ""
End If
End Function

This macro was working fine.

Finally I used the following function after copying both the extracted reference and total to a new sheet and creating a datatable for that

=IF(ISBLANK([@Reference]), "", (IF((ROUND(SUMIFS([Total],[Reference],[@Reference]),2)=0), "complete", "")))

This also worked fine.

Now what I actually want is I need to avoid creating any new data tables or sheets and preform all this within current sheet on a single button click. Is there anyway that can be done without making the macro a time consuming process? Your help is higly appreciated!

Thanks in Advance

eccentricCoder
  • 846
  • 1
  • 14
  • 35
  • 1
    variant Array explanation is [this](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros/10717999#10717999) – Dy.Lee Jul 25 '17 at 13:36

2 Answers2

1

for the first part try:

Private Sub getTotal_Click()
Dim lastRow As Long
Dim sumRange As Range

    With ActiveSheet
       lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Set sumRange = Range(Range("K5"), Range("K" & lastRow))
    sumRange.FormulaR1C1 = "=RC[-5]+RC[-4]"
    sumRange.Copy
    sumRange.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

also, if you still want to loop notice that calling cell like .Cells(1, 1) is faster than Range("A1")

avb
  • 1,743
  • 1
  • 13
  • 23
1

You need using Variant Array. It is faster.

Private Sub getTotal_Click()
    Dim vDB As Variant, vR() As Variant
    Dim i As Long, n As Long, lastRow As Long

    With ActiveSheet
       lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       vDB = .Range("f5", "g" & lastRow)
        n = UBound(vDB, 1)
        ReDim vR(1 To n, 1 To 1)
        For i = 1 To n
            vR(i, 1) = vDB(i, 1) + vDB(i, 2)
        Next i
       .Range("k5").Resize(n) = vR
    End With

End Sub
Dy.Lee
  • 7,527
  • 1
  • 12
  • 14