VBA Frequency Highlighter Function in Very Large Excel Sheet -


in previous post user: locengineer managed me write finding function find least frequent values in column of particular category.

the vba code works part particular issues, , previous question had been answered sufficiently answer already, thought required new post.

locengineer: "holy smoking moly, batman! if sheet.... i'd say: forget "usedrange". won't work enough spread... i've edited above code using more hardcoded values. please adapt values according needs , try that. woah mess."

here code:

sub frequenz() dim col range, cel range dim letter string dim lookfor string dim frequency long, totalrows long dim relfrequency double dim ran range  ran = activesheet.range("a6:fs126") totalrows = 120  each col in ran.columns     '***get column letter***     letter = split(activesheet.cells(1, col.column).address, "$")(1)     '*******     each cel in col.cells         lookfor = cel.text         frequency = application.worksheetfunction.countif(range(letter & "2:" & letter & totalrows), lookfor)         relfrequency = frequency / totalrows          if relfrequency <= 0.001             cel.interior.color = colorconstants.vbyellow         end if     next cel  next col  end sub 

the code formatted this: (notice merged cells head each column titles. titles go down row 5 , data starts on row 5) (also notice rows filled empty columns, more data.) enter image description here

finally, 1 important change cant figure out how ignore blank cells. please advise. thank you.

if 2 adjustments made 1. exclude headers, , 2. blank cells

  1. exclude headers in way bit more dynamic; excludes top 6 rows:

with activesheet.usedrange     set ran = .offset(6, 0).resize(.rows.count - 6, .columns.count) end 

  1. in inner loop, after line for each cel in col.cells need if:

for each cel in col.cells     if len(cel.value2) > 0 then... 

here modified version (untested):


option explicit  sub frequenz()     const min_row   long = 6     const max_row   long = 120      dim col range     dim cel range     dim rng range      dim letter      string     dim lookfor     string     dim frequency   long      activesheet.usedrange         set rng = .offset(min_row, 0).resize(max_row, getmaxcell.column)     end      each col in rng.columns         letter = split(activesheet.cells(1, col.column).address, "$")(1)          each cel in col             lookfor = cel.value2              if len(lookfor) > 0    'process non empty values                 frequency = worksheetfunction.countif( _                                 range(letter & "2:" & letter & max_row), lookfor)                  if frequency / max_row <= 0.001                     cel.interior.color = colorconstants.vbyellow                 end if             end if         next cel     next col end sub 

.

updated use new function when determining last row , column containing values:


public function getmaxcell(optional byref rng range = nothing) range      'it returns last cell of range data, or a1 if worksheet empty      const nonempty string = "*"     dim lrow range, lcol range      if rng nothing set rng = application.activeworkbook.activesheet.usedrange      if worksheetfunction.counta(rng) = 0         set getmaxcell = rng.parent.cells(1, 1)     else         rng             set lrow = .cells.find(what:=nonempty, lookin:=xlformulas, _                                    after:=.cells(1, 1), _                                    searchdirection:=xlprevious, _                                    searchorder:=xlbyrows)             set lcol = .cells.find(what:=nonempty, lookin:=xlformulas, _                                    after:=.cells(1, 1), _                                    searchdirection:=xlprevious, _                                    searchorder:=xlbycolumns)             set getmaxcell = .parent.cells(lrow.row, lcol.column)         end     end if end function 


Comments

Popular posts from this blog

java - Andrioid studio start fail: Fatal error initializing 'null' -

android - Gradle sync Error:Configuration with name 'default' not found -

StringGrid issue in Delphi XE8 firemonkey mobile app -