excel - VBA Spelling Test -

excel - VBA Spelling Test -

the aim of next automate spelling test process. each word in test has attached word list of between 1 , 11 11 words students need practise if unable spell word correctly.

the vba below generates list of words individual specified in cell c2 vba generate list of words available individuals. thinking need 'for... each' loop i'm not quite sure how implement.

ideally, words outputted worksheet contains next info:

a summary @ top outlines students have completed test , number of words have been allocated. summary highlights students have less 10 words need finish next test , students have more 10 less 50, need finish next test in near future.

a section individual students have more 0 words specifies: first name, surname, number of words , date. words should appear in grid 12 columns wide , necessary number of rows high.

sub generatespellingwords() dim namecolumnnumber integer dim nameperson string dim ws worksheet namecolumnnumber = sheets("dashboard").range("i2").value nameperson = sheets("dashboard").range("c2").value sheets.add.name = nameperson range("a1:l1").select selection.merge selection .horizontalalignment = xlcenter .verticalalignment = xlcenter end activecell.formular1c1 = nameperson & "'s spelling words" rows("1:1").rowheight = 27.75 range("a1:l1").select selection.font.bold = true selection.font .size = 14 end sheets("dashboard").select rows("4:34").select selection.autofilter sheets("dashboard").range("$a$4:$w$34").autofilter field:=namecolumnnumber, criteria1:="n" sheets("dashboard").range("c5:n34").select selection.copy sheets(nameperson).select range("a2").select selection.pastespecial paste:=xlpastevalues, operation:=xlnone, skipblanks _ :=false, transpose:=false cells.replace what:="0", replacement:="'", lookat:=xlpart, searchorder _ :=xlbyrows, matchcase:=false, searchformat:=false, replaceformat:=false range("a2").select sheets("dashboard").select range("c2").select selection.autofilter end sub

i agree d mason, impossible deduce want specification. supply lot of detail much detail needed programmer missing. hard missing parts of design via exchange of comments have decided guess seek. if study specification , utilize f8 single step through code should able find how accomplish particular effects. can utilize enhanced vba knowledge write macros want.

i guessing of existing code created using macro recorder. way of learning syntax of unfamiliar statement not way of learning vba. recorder not know intentions records each action happens. result syntactically right vba not vba. studying macros enhance understanding of vba must spend time on systematic study.

search web “excel vba tutorial” , find many. seek few , pick 1 matches learning style. local college may offer short courses cover basics. prefer books. visited big library , spent half-an-hour looking through vba primers. borrowed 3 liked seek out @ home. bought favourite. have on shelf , still refer time time; investment. time spend learning vba repay it.

i deduce code columns o of worksheet “dashboard” contain word lists. perhaps column contains list number no matter. columns p, q , on individual students , contain “n” if pupil has not yet mastered row’s list. rows 4 34 contain word lists no uncertainty add together more later. dashboard:

i have filled word list area formulaic info because helps testing code. not know how utilize rows 1 3 , have left them blank.

i have created new worksheet “students” initialised to:

i envisage columns c, d , on beingness used other pupil info have used “name” , “to do” column. explain “to do” column later.

i ran macro addnewstudent(). worksheets “dashboard” , “students” changed shown below. @ bottom of worksheets “dashboard”, can see worksheets have been created. show worksheet “george”.

if new pupil joins class, add together name worksheets “students” , rerun addnewstudent().

macro outputwordlists() outputs word lists each student. not assume manually remove ns worksheet “dashboard” students demonstrate mastery of various word lists. time time rerun outputworklists() update statistics in worksheet “students” , produce new word lists students print , distribute if appropriate.

i have updated worksheet “dashboard” reflect students’ progress , have run addnewstudent() create worksheet new pupil frederick. have added more word lists @ bottom.

i ran outputwordlists(). has no effect on worksheet “dashboard”. worksheet “students” has been updated record current number of ns in “to do” column. express involvement in other statistics not understand want. hope have given plenty techniques allow decide how add together code calculate these statistics. worksheet “george” has been updated next 10 word lists has master. have included 10 word lists because thought listing lot intimidating.

as said @ beginning, should single step through macros , study do. come questions if necessary more can find on own, faster develop vba skills. hope gives plenty ideas progress.

i should perhaps mention these macros development macros , include debug.print , debug.assert statements. never include such statements in production macro distributing others invaluable aids during development.

good luck , welcome joys of programming.

option explicit ' utilize info type "long" rather "integer". "integer" specifies 16-bit ' number requires special processing on 32-bit computer. ' using constants makes code easier understand , easier maintain. const coldshbrdfirstname long = 16 const colstdlstname long = 1 const colstdlsttodo long = 2 const rowdshbrdfirstwordlist long = 4 sub addnewstudent() dim coldshbrdcrnt long dim found boolean dim inxwsht long dim rng range dim rowdshbrdlast long dim rowstdlstcrnt long dim studentname string ' speeds macro , stops screen flashing new worksheets created application.screenupdating = false ' identify lastly row containing word list worksheets("dashboard") set rng = .cells.find("*", .range("a1"), xlformulas, , xlbyrows, xlprevious) if rng nil ' no info found debug.assert false exit sub else rowdshbrdlast = rng.row debug.print "last word list on row " & rowdshbrdlast end if end rowstdlstcrnt = 2 ' assume 1 header row while true ' extract new name pupil list studentname = worksheets("students").cells(rowstdlstcrnt, colstdlstname).value if studentname = "" ' name list exhausted exit end if ' existing worksheet pupil found = false inxwsht = 1 worksheets.count if worksheets(inxwsht).name = studentname ' worksheet pupil found found = true exit end if next if not found ' new pupil ' create new worksheet pupil ' add together new worksheet after existing worlsheets worksheets.add after:=worksheets(worksheets.count) ' new worksheet active worksheet activesheet.name = studentname ' note 1: not select because select slow command. ' note 2: 1 time have merged range a1:l1, write cell a1. cells ' b1 l1 no longer exist. range("a1:l1").merge range("a1") .horizontalalignment = xlcenter .verticalalignment = xlcenter .value = studentname & "'s spelling words" .rowheight = 27.75 .font .bold = true .size = 14 end end worksheets("dashboard") ' find empty column pupil , initialise it. if .cells(rowdshbrdfirstwordlist - 1, coldshbrdfirstname).value = "" ' first pupil coldshbrdcrnt = coldshbrdfirstname elseif .cells(rowdshbrdfirstwordlist - 1, coldshbrdfirstname + 1).value = "" ' sec pupil coldshbrdcrnt = coldshbrdfirstname + 1 else ' find first unused column ' .end(xltoright) vba equivalent of clicking ctrl+rightarrow. ' experiment ctrl+rightarrow find why test first , sec ' columns before using .end(xltoright). coldshbrdcrnt = .cells(rowdshbrdfirstwordlist - 1, _ coldshbrdfirstname).end(xltoright).column + 1 end if ' add together name title , fill column ns .cells(rowdshbrdfirstwordlist - 1, coldshbrdcrnt).value = studentname .range(.cells(rowdshbrdfirstwordlist, coldshbrdcrnt), _ .cells(rowdshbrdlast, coldshbrdcrnt)).value = "n" end worksheets("students") ' record number of ns in todo column .cells(rowstdlstcrnt, colstdlsttodo).value = _ rowdshbrdlast - rowdshbrdfirstwordlist + 1 end end if ' not found rowstdlstcrnt = rowstdlstcrnt + 1 loop ' until pupil list exhaused worksheets("dashboard").activate end sub sub outputwordlists() dim coldshbrdcrnt long dim coldshbrdlast long dim found boolean dim inxrng long dim inxwsht long dim numtodo long dim rng range dim rngcopy range dim rngdshbrdcrnt range dim rowdshbrdlast long dim rowstdlstcrnt long dim studentname string ' find lastly row , column of "dashboard" worksheets("dashboard") coldshbrdlast = .cells(rowdshbrdfirstwordlist - 1, columns.count).end(xltoleft).column set rng = .cells.find("*", .range("a1"), xlformulas, , xlbyrows, xlprevious) if rng nil ' no info found debug.assert false exit sub else rowdshbrdlast = rng.row end if end debug.print "last pupil column " & coldshbrdlast debug.print "last word list on row " & rowdshbrdlast ' loop each pupil column coldshbrdcrnt = coldshbrdfirstname coldshbrdlast ' pupil name , number of word list worksheets("dashboard") studentname = .cells(rowdshbrdfirstwordlist - 1, coldshbrdcrnt).value set rng = .range(.cells(rowdshbrdfirstwordlist, coldshbrdcrnt), _ .cells(rowdshbrdlast, coldshbrdcrnt)) numtodo = application.worksheetfunction.countif(rng, "n") end debug.print studentname & " has " & numtodo & " word lists do" ' locate row pupil in "students" worksheets("students") set rng = .columns(1).find(studentname, .range("a1"), xlformulas, , xlbyrows, xlprevious) if rng nil ' pupil not found debug.assert false exit sub else rowstdlstcrnt = rng.row end if .cells(rowstdlstcrnt, colstdlsttodo).value = numtodo end worksheets("dashboard") ' locate rows not done pupil if .autofiltermode ' autofilter on turn off in case wrong filter selected .cells.autofilter end if .cells.autofilter field:=coldshbrdcrnt, criteria1:="n" set rng = .autofilter.range.specialcells(xlcelltypevisible) .cells.autofilter ' switch off debug.print studentname & " " & rng.address set rng = rng.entirerow debug.print studentname & " " & rng.address ' ensure maximum of 10 rows have been selected copying. ' discard header rows set rngcopy = nil inxrng = 0 each rngdshbrdcrnt in rng if rngdshbrdcrnt.row < rowdshbrdfirstwordlist ' ignore header row else if rngcopy nil ' first row set rngcopy = rngdshbrdcrnt else ' subsequent row set rngcopy = union(rngcopy, rngdshbrdcrnt) end if inxrng = inxrng + 1 if inxrng = 10 exit end if next rngdshbrdcrnt debug.print studentname & " " & rngcopy.address ' cut down re-create range word lists. is, exclude pupil columns set rngcopy = intersect(rngcopy, .range(.columns(1), .columns(coldshbrdfirstname - 1))) debug.print studentname & " " & rngcopy.address end ' locate worksheet pupil found = false inxwsht = 1 worksheets.count if worksheets(inxwsht).name = studentname ' worksheet pupil found found = true exit end if next if not found ' no worksheet pupil debug.assert false exit sub end if worksheets(inxwsht) ' clear existing contents except title row .range(.rows(2), .rows(rows.count)).entirerow.delete ' re-create word lists across rngcopy.copy destination:=.range("a3") end next coldshbrdcrnt end sub

excel vba excel-vba