vba - How to combine multiple macros and excel functions into a single macro that executes on button click? -


i need combine multiple macros single macro executes on button click. kindly excuse me if write wrong since new excel macros , vb.

following scenario.

steps:

  1. calculate total
  2. extract reference
  3. compare total field value matching reference , mark "complete" if sum of total matching references calculates ).

(explained...) first calculate debit , credit amount new column called total, this, used sum function. after tried same using macro executes on button click

(old macro)

private sub gettotal_click()     activesheet        lastrow = .cells(.rows.count, "a").end(xlup).row     end = 5 lastrow     range("k" & i).value = range("f" & i).value + range("g" & i).value next end sub 

this time consuming (took around 2 hrs when executed on 75k records) when using formula (which finished in minutes). still not able understand reason this. modifiying dy.lee's answer below, took seconds calculate total.

(modified based on dy.lee's answer)

private sub gettotal_click()     dim vdb variant, vr() variant     dim long, n long, lastrow long      activesheet        lastrow = .cells(.rows.count, "a").end(xlup).row        vdb = .range("r5", "s" & lastrow)        n = ubound(vdb, 1)        redim vr(1 n, 1 1)        = 1 n            vr(i, 1) = vdb(i, 1) + vdb(i, 2)        next       .range("al5").resize(n) = vr     end  end sub 

now moving on second macro used extract pattern strings in column d , e.

function extractreference(cid_no string, pm_source string) dim regexp object, findmatches object, match object dim init_result string: init_result = ""  set regexp = createobject("vbscript.regexp") regexp     .global = true     .multiline = false     .pattern = "(?:^|\d)(\d{5,6})(?!\d)" end   set findmatches = regexp.execute(pm_source) each match in findmatches     init_result = init_result + match.submatches.item(0) next  if init_result <> ""     extractreference = cid_no & " | " & init_result else     extractreference = "" end if end function 

this macro working fine.

finally used following function after copying both extracted reference , total new sheet , creating datatable that

=if(isblank([@reference]), "", (if((round(sumifs([total],[reference],[@reference]),2)=0), "complete", "")))

this worked fine.

now want need avoid creating new data tables or sheets , preform within current sheet on single button click. there anyway can done without making macro time consuming process? higly appreciated!

thanks in advance

for first part try:

private sub gettotal_click() dim lastrow long dim sumrange range      activesheet        lastrow = .cells(.rows.count, "a").end(xlup).row     end     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 still want loop notice calling cell .cells(1, 1) faster range("a1")


Comments

Popular posts from this blog

html - How to set bootstrap input responsive width? -

javascript - Highchart x and y axes data from json -

javascript - Get js console.log as python variable in QWebView pyqt -