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:
- calculate total
- extract reference
- 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
Post a Comment