Excel VBA - Finding the beginning and end of coloured rows -

-

i trying create code in excel vba, locate beginning (cell address) , end (cell address) of coloured rows in table. table timeline(horizontal axis- dates, vertical axis - general text). coloured rows not start in first column, start in different columns. help?

how's this?

sub findcoloredrows() dim startcol integer, endcol integer, o integer dim ws            worksheet dim integer, k integer dim startrow long, endrow long dim cellcolor string, nocolor string dim cel           range  nocolor = -4142              ' color index of no coloring  k = 3  set ws = activesheet ws     startrow = .cells(1, 3).end(xldown).row     startcol = .cells(1, 3).column     while startrow > 100  ' assume table starts before row 100.  so, if there's no data before row 100, check next column         k = k + 1         startrow = .cells(1, k).end(xldown).row         startcol = k     loop      'now, have our starting row - end row.     endrow = .cells(startrow, k).end(xldown).row      endcol = .cells(startrow, startcol).end(xltoright).column     debug.print "start row: " & startrow & ", start column: " & startcol      ' how many non colored cells there in our range?     dim nocolorcells integer     each cel in .range(.cells(startrow, startcol), .cells(endrow, endcol))         if cel.interior.colorindex = nocolor             nocolorcells = nocolorcells + 1         end if     next cel     debug.print "there " & nocolorcells & " non colored cells."      .cells(startrow - 1, endcol + 2).value = "start date"     .cells(startrow - 1, endcol + 3).value = "end date"      'redim array fit colored cells     redim tdates(1 nocolorcells + 1)     = 1                    'index starts @ 1, set 1      k = startrow endrow         o = startcol endcol             if .cells(k, o).interior.colorindex = nocolor , .cells(k, endcol + 2) = ""                 .cells(k, endcol + 2).value = .cells(k, o).value             elseif .cells(k, o).interior.colorindex = nocolor , .cells(k, endcol + 2)                 = +                 .cells(k, endcol + 3).value = .cells(k, o).value             end if             ' = + 1         next o          = + 1     next k  end  msgbox ("done!")  end sub

this sub find addresses of colored cells. if can explain more mean "locate beginning , end of coloured rows in table." can tweak this. can post image of sample table maybe?

edit: per discussion below, try in case there's not data in table, want columns of colored cells:

sub findcoloredbgcells() dim startrow integer, endrow integer, integer, k integer, startcol integer, endcol integer dim cellcolor string, nocolor string dim ws worksheet  set ws = activesheet nocolor = -4142  ws     'get starting row     startrow = .cells(1, 1).end(xldown).row     endrow = .cells(startrow, 1).end(xldown).row      ' since know names start , end (less 1 "names" part), let's count how many names have     dim nonames integer     nonames = endrow - startrow     if not isempty(.cells(1, 1)) ' first used column data         startcol = 1     elseif isempty(.cells(1, 1))         startcol = .cells(1, 1).end(xltoright).column     end if      endcol = .cells(1, startcol).end(xltoright).column      'now have our range, let's use loop blank cells, , add array     dim coloredcells() variant     redim coloredcells(1 nonames, 2)     dim rng range, cel range     set rng = .range(.cells(startrow, startcol), .cells(endrow, endcol))     'rng.select      'now, count how many cells not blank background     dim cnt integer, celrow integer, lastcelrow integer     = 1      lastcelrow = 2     each cel in rng         cel.select         celrow = cel.row         if cel.row <> lastcelrow 'this can change first dimension in array             k = k + 1             coloredcells(k, 0) = .cells(cel.row, 1).value             = 1            ' = + 1         end if          if cel.interior.colorindex <> nocolor             cnt = cnt + 1             if > 2 = 2 'since it's 2 dimensions need, go '1'            ' redim preserve coloredcells(nonames, i) 'resize array hold new column             coloredcells(k, i) = .cells(1, cel.column).value             = + 1         end if         lastcelrow = celrow     next cel  k = 1 ubound(coloredcells)         debug.print coloredcells(k, 0) & " start date: " & coloredcells(k, 1) & ", end date: " & coloredcells(k, 2) & "."         .cells(2 + k, 2).value = coloredcells(k, 1)         .cells(2 + k, 3).value = coloredcells(k, 2) next k  end  msgbox ("done!")  end sub

Comments

Post a Comment

Popular posts from this blog

Fail to load namespace Spring Security http://www.springframework.org/security/tags -

-
i have problem namespace of spring security on xhtml page. don't understand why can't load uri, , have following issue: whitelabel error page application has no explicit mapping /error, seeing fallback. tue jul 21 16:58:12 utc 2015 there unexpected error (type=not found, status=404). please need help! possible uri has been changed? best regards you using incorrect namespace url. correct url http://www.springframework.org/schema/security the error page seeing spring source website since not recognize url. try visiting http://www.springsource.org/security/tags in browser update : spring security tags used in jsp page correct tag lib declaration is: <%@ taglib prefix="sec" uri="http://www.springframework.org/security/tags" %>
Read more

sql - MySQL query optimization using coalesce -

-
can explain me why second query faster first? (first 1 takes around 40 seconds, second 1 less 0.1) select releases.feature_code, releases.platform_id, version, release_date, general_available, uri, filesize, display_name, feature_name.full_name, if ((select exists(select 1 release_exceptions releases.feature_code = release_exceptions.feature_code , releases.platform_id = release_exceptions.platform_id , releases.version = release_exceptions.version) = 1), 1, 0) release_exceptions releases left outer join platform using(platform_id) left outer join feature_name using(feature_code) order version desc; ~~~ query 2 ------------------ ~~~ select feature_code, version, release_date, general_available, platform_id, uri, filesize, display_name, feature_name.full_name, coalesce(release_exceptions, 0) release_exceptions mus.releases left outer join ( select distinct feature_code, version, platform_id, 1 release_exceptions mus.release_exceptions ) release_exceptions using ...
Read more

unity3d - Unity local avoidance in user created world -

-
i'm using unity3d networked multiplayer online game have large complex 3d terrain scene forest, trees, cliff, hills, mountains, bounders, etc. players can build structures sort of minecraft, , put them anywhere in scene, or move them around anytime. aside human controlled players, there automated ai players , objects animals roaming around scene following path. the problem how make these automated ai players , animals, able navigate around static , dynamic player created structures, because path follow can blocked player created structures, or other players , other ai objects, cliffs etc. have find away around them or on track if tumble down off high cliff example. so made navmesh , used navagents, takes care of static, non moving objects, how make ai players navigate around each other , dynamic structures created players can number in hundreds? i thought of adding navmeshobstacle everything, result in being attached hundreds of objects since user created structures b...
Read more