vba - Grouping similar names in a column and offset to sum that grouped range -

i have macro running in excel. have companies’ names in column “d”. name of column security description (long 1). trying group similar sounding names or identical names , insert row between groups. macro working grouping not accurate right now. code below:

dim rowcount integer dim n integer  rowcount = range(range("a15000").end(xlup), "a7").rows.count  range("d6").select  if selection <> ""     n = 1 rowcount + 1         selection.offset(1, 0).select         if selection <> selection.offset(-1, 0)             if selection.offset(-1, 0) "* security description (long 1)*"                 selection.entirerow.insert shift:=xldown                 selection.entirerow.insert shift:=xldown                   selection.offset(2, 0).select             else                 selection.entirerow.insert shift:=xldown                 selection.entirerow.insert shift:=xldown                    if selection.offset(-2) = vbnullstring                     selection.offset(0, 2) = selection.offset(-1, 2)                 else                     selection.offset(0, 3) = application.worksheetfunction.sum(range(selection.offset(-1, 3), selection.offset(-1, 3).end(xlup)))                 end if                  selection.offset(0, 3).font.bold = true                  selection.offset(0, 3).borders(xledgetop)                     .linestyle = xlcontinuous                     .weight = xlthin                     .colorindex = xlautomatic                 end                 selection.offset(0, 3).borders(xledgebottom)                     .linestyle = xldouble                     .weight = xlthick                     .colorindex = xlautomatic                 end              selection.offset(3, 0).select             end if         end if     next n end if  range("a15000").end(xlup).clear 

there no point fussing else until have grouping correct.

in of examples have space after group identifier. in “smith jane”, “smith” group id. exception “abbey1” part of “abbey” group though there no space between “abbey” , “1”. may typing error moment have ignored “abbey1”. if mistake, can correct later.

i have written 2 macro: getgroupid , testgetgroupid.

note: if not sure how something, experiment issue in isolation. when have routines work entire satisfaction should @ rest of requirement.

macro getgroupid takes name parameter , returns first space or entire name if there no space. if “abbey1” part of “abbey” group, macro need enhancement let try simple version first.

macro testgetgroupid provides test bed macro getgroupid.

it best reference worksheets name rather assume active worksheet 1 required. have used name “name” data worksheet. macro needs worksheet can output diagnostic information. have named worksheet “test”. if name “name” wrong or if name “test” unacceptable because use name, change them. search “##########” find under variable definitions in macro testgetgroupid. these worksheet names defined.

for test, created worksheet “name” containing:

if misunderstood data, let me know.

the output macro macro testgetgroupid is:

the last column used “h” because coltestmax has value of 8. (column “h” equivalent column 8). if have short names increase value of coltestmax , still have columns on screen.

run macro testgetgroupid against names. worksheet “test” show them being grouped correctly? tell me if mis-grouped. don't worry these macros; provide more explanation final macro.

option explicit sub testgetgroupid()    ' group names using getgroupid() , output diagnostics   ' check grouping correct.    dim coltestcrnt long   dim groupidcrnt string   dim groupidcrntgroup string   dim namecrnt string   dim rownamecrnt long   dim rownamelast long   dim rowtestcrnt long   dim wshtname worksheet   dim wshttest worksheet    const colnamename long = 4         ' column d   const coltestgroupid long = 1   const coltestrowfirst long = 2   const coltestrowlast long = 3   const coltestnamefirst long = 4    ' column must come after groupid,                                         ' rowfirst , rowlast   ' coltestmax controls number of of names on row of worksheet "test"   ' if names short might wish increase coltestmax. if names long   ' might wish reduce coltestmax.   const coltestmax long = 8   const rownamedatafirst long = 7    application.screenupdating = false    ' * ########## replace "name" name worksheet containing   '              names.   set wshtname = worksheets("name")   ' * ########## replace "test" name of choice if have   '              worksheet named "test".   set wshttest = worksheets("test")    wshtname     rownamelast = .cells(rows.count, colnamename).end(xlup).row  ' last used row of name column     namecrnt = .cells(rownamedatafirst, colnamename).value       ' first name     groupidcrntgroup = getgroupid(namecrnt)                  ' first group id     rownamecrnt = rownamedatafirst   end    wshttest     .cells.entirerow.delete                                  ' clear existing data     ' build header line     .cells(1, coltestgroupid).value = "group id"     .cells(1, coltestrowfirst).value = "row first"     .cells(1, coltestrowlast).value = "row last"     .cells(1, coltestnamefirst).value = "names within group -->"     .range(.cells(1, coltestnamefirst), .cells(1, coltestmax)).merge     .range(.cells(1, 1), .cells(1, coltestnamefirst)).font.bold = true     rowtestcrnt = 2     ' start first row first group id     .cells(rowtestcrnt, coltestgroupid).value = groupidcrntgroup     .cells(rowtestcrnt, coltestrowfirst).value = rownamecrnt     coltestcrnt = coltestnamefirst     .cells(rowtestcrnt, coltestcrnt).value = namecrnt   end    rownamecrnt = rownamedatafirst + 1    ' rownamedatafirst has been processed    ' for-next-loop more convenient within desired   ' macro rows inserted rownamelast increase. end value of   ' for-next-loop cannot modified within loop do-loop must used.   ' use do-loop here consistent.   while rownamecrnt <= rownamelast     namecrnt = wshtname.cells(rownamecrnt, colnamename).value     groupidcrnt = getgroupid(namecrnt)     if groupidcrnt = groupidcrntgroup       ' have name row within current group. add name worksheet "test"       coltestcrnt = coltestcrnt + 1       if coltestcrnt > coltestmax         ' current row of worksheet "test" full.  advance next row.         coltestcrnt = coltestnamefirst         rowtestcrnt = rowtestcrnt + 1       end if       wshttest.cells(rowtestcrnt, coltestcrnt).value = namecrnt     else       ' have first row of next group. finish off last group , start new.       wshttest         .cells(rowtestcrnt, coltestrowlast).value = rownamecrnt - 1         rowtestcrnt = rowtestcrnt + 1         groupidcrntgroup = groupidcrnt         .cells(rowtestcrnt, coltestgroupid).value = groupidcrntgroup         .cells(rowtestcrnt, coltestrowfirst).value = rownamecrnt         coltestcrnt = coltestnamefirst         .cells(rowtestcrnt, coltestcrnt).value = namecrnt       end     end if     rownamecrnt = rownamecrnt + 1   loop    ' finish off last group   wshttest     .cells(rowtestcrnt, coltestrowlast).value = rownamecrnt - 1     .columns.autofit   end  end sub function getgroupid(byval name string) string    dim posspace long    posspace = instr(1, name, " ")    if posspace = 0     ' no spaces within name     getgroupid = name   else     ' groupid before space     getgroupid = mid(name, 1, posspace - 1)   end if  end function 

part 2

with selects , offsets, struggled identify attempting. code below version of think attempting.

make sure have saved data before running macro.

there lot of information , advice within macro not information statements use. come questions if necessary more can work out looking statements faster develop own skills.

i found using borders around inserted line messy small groups. have left original code have commented out. use colour highlight inserted line.

i believe have provided enough information adjust macro exact requirements.

option explicit sub group()    ' identify groups of names , separate blank   ' row containing total of column "g" group.    ' # macro needs access getgroupid.  if getgroupid not in same   '   module, add "public" beginning of definition of getgroupid:   '      public function getgroupid(byval name string) string    ' # long better integer vba data type on modern computers   dim groupgrandtotal long   dim groupidcrnt string   dim groupidcrntgroup string   dim namecrnt string   ' # please avoid variable names "n".  not matter   '   small macro bigger macros having meaningless names makes   '   coding , maintenance more difficult.  have system can   '   @ macro wrote years ago , know variables are.   '   can big help. may not system fine; develop   '   own system.   dim rownamecrnt long   dim rownamelast long   dim wshtname worksheet    ' # constants same literals except:   '     * make code easier read.   '     * make updating code easier if, example, column moves.   const colnamename long = 4       ' column d   const colnametotal long = 7      ' column g   ' * ########## define range borders. adjust necessary.   const colnamefirst long = 1      ' column   const colnamelast long = 8       ' column h   const rownamedatafirst long = 7    ' without every insert causes screen repainted.   ' can extend duration of macro significantly.   application.screenupdating = false    ' # 1 worksheet accessed macro.  have :   '      worksheets("name")   '   @ top instead of   '      wshtname   ' # note "with worksheets("name")" slow command because   '   interpreter has "name" in collection of worksheets.  if   '   switching between worksheets, wshtname can   '   faster worksheets("name").   ' # not specifying worksheet, assuming active worksheet   '   correct worksheet.  if have 1 worksheet may   '   correct.  however, if there multiple worksheets, relying on   '   user selecting correct worksheet before starting macro.   '   better explicit.   ' # ########## replace "name" name worksheet containing   '              names.   set wshtname = worksheets("name")    wshtname     ' # not find rowcount obvious.  find specifying first row     '   constant, finding last row , using rowcrnt (current row)     '   loop variable easier understand.     rownamelast = .cells(rows.count, colnamename).end(xlup).row  ' last used row of name column     namecrnt = .cells(rownamedatafirst, colnamename).value       ' first name     groupgrandtotal = .cells(rownamedatafirst, colnametotal).value     groupidcrntgroup = getgroupid(namecrnt)                  ' first group id     rownamecrnt = rownamedatafirst      ' # avoid select. slow command , can make code     '   obscure particularly if use offset on changing     '   selection.      rownamecrnt = rownamedatafirst + 1    ' rownamedatafirst has been processed      ' # use for-next-loop insertion of rows means     '   value of rownamelast increase. end value of for-next-loop cannot     '   modified within loop do-loop must used.     '   use do-loop here consistent.     while rownamecrnt <= rownamelast       namecrnt = wshtname.cells(rownamecrnt, colnamename).value       groupidcrnt = getgroupid(namecrnt)       if groupidcrnt = groupidcrntgroup         ' have name row within current group. add total grand total         groupgrandtotal = groupgrandtotal + .cells(rownamecrnt, colnametotal).value       else         ' have first row of next group. finish off last group         .rows(rownamecrnt).insert         rownamelast = rownamelast + 1         ' rownamecrnt number of new row.         ' tried setting borders found effect messy when small         ' group.  thought coloured row more effective         '' set borders         'with .range(.cells(rownamecrnt, colnamefirst), .cells(rownamecrnt, colnamelast))         '  .borders(xledgetop)         '    .linestyle = xlcontinuous         '    .weight = xlthin         '  end         '  .borders(xledgebottom)         '    .linestyle = xldouble         '    .weight = xlthick         '  end         'end         .range(.cells(rownamecrnt, colnamefirst), .cells(rownamecrnt, colnamelast))           .interior.color = rgb(255, 255, 153)      ' light yellow         end         ' insert grand total group         .cells(rownamecrnt, colnametotal).value = groupgrandtotal         ' start new group         rownamecrnt = rownamecrnt + 1     ' first row of next group         groupidcrntgroup = groupidcrnt         groupgrandtotal = .cells(rownamecrnt, colnametotal).value       end if       rownamecrnt = rownamecrnt + 1     loop      ' finish off last group     rownamecrnt = rownamelast + 1     '' set borders     'with .range(.cells(rownamecrnt, colnamefirst), .cells(rownamecrnt, colnamelast))     '  .borders(xledgetop)     '    .linestyle = xlcontinuous     '    .weight = xlthin     '  end     '  .borders(xledgebottom)     '    .linestyle = xldouble     '    .weight = xlthick     '  end     'end     .range(.cells(rownamecrnt, colnamefirst), .cells(rownamecrnt, colnamelast))       .interior.color = rgb(255, 255, 153)      ' light yellow     end     ' insert grand total group     .cells(rownamecrnt, colnametotal).value = groupgrandtotal    end  ' wshtname  end sub