Excel VBA error: "cannot complete task with available resources" -

i wonder whether may able me please.

with along way i've put following script performs following:

• searches column b (containing approx 31,000 rows of data) of sheet "all data" unique values.
• for each unique value, code try find matching sheet same value within workbook.
• where match found i'm trying use code below create graph data on sheet.

sub forecastscharts()      dim chtob chartobject     dim lw long     dim rng range     dim rngtocover range     dim sshapename string     dim shtrng range     dim long     dim rowindex     dim ad worksheet     dim col long     dim datarow long     dim rw long      sheets("all data").select     application.screenupdating = false      datarow = 8      until cells(datarow, 2).value = "" ' loop through data rows         sheets(cells(datarow, 2).value) ' output go applicable portfolio sheet found in column b              set rng = .range("b11").currentregion              'if application.countif(rng, "<>") = rng.columns.count   ' data points required              if application.countif(rng, "<>") > 0    ' @ least 1 data point                 activesheet.shapes.addchart(left:=48, width:=468, top:=300, height:=300).chart                     .plotby = xlrows                     .charttype = xlcolumnclustered                     rowindex = 2 rng.rows.count                         .seriescollection.newseries                             'this series name                             .name = "='" & rng.parent.name & "'!" & rng.cells(rowindex, 1).address(, , xlr1c1)                             .values = "='" & rng.parent.name & "'!" & rng.rows(rowindex).cells(1, 2).resize(1, rng.columns.count - 1).address(, , xlr1c1)                             .xvalues = "='" & rng.parent.name & "'!" & rng.rows(1).cells(1, 2).resize(1, rng.columns.count - 1).address(, , xlr1c1)                             .applydatalabels autotext:=true, legendkey:=false, _                             hasleaderlines:=true, showseriesname:=false, _                             showcategoryname:=false, showvalue:=true, _                             showpercentage:=true, showbubblesize:=false, _                             separator:="" & chr(13) & ""                         end                     next                 end             end if         end     loop end sub 

updated code

sub forecastscharts()      dim chtob chartobject     dim lw long     dim rng range     dim rngtocover range     dim sshapename string     dim shtrng range     dim long     dim rowindex long     dim ad worksheet     dim col long     dim datarow long     dim rw long     dim alldatasheet worksheet       set alldatasheet = sheets("all data")     application.screenupdating = false      datarow = 8      until alldatasheet.cells(datarow, 2).value = "" ' loop through data rows         sheets(alldatasheet.cells(datarow, 2).value) ' output go applicable portfolio sheet found in column b      set rng = .range("b8").currentregion      'if application.countif(rng, "<>") = rng.columns.count   ' data points required      if application.countif(rng, "<>") > 0    ' @ least 1 data point         .shapes.addchart(left:=48, width:=468, top:=300, height:=300).chart             .plotby = xlrows             .charttype = xlcolumnclustered             rowindex = 2 rng.rows.count                 .seriescollection.newseries                     'this series name                     .name = "='" & rng.parent.name & "'!" & rng.cells(rowindex, 1).address(, , xlr1c1)                     .values = "='" & rng.parent.name & "'!" & rng.rows(rowindex).cells(1, 2).resize(1, rng.columns.count - 1).address(, , xlr1c1)                     .xvalues = "='" & rng.parent.name & "'!" & rng.rows(1).cells(1, 2).resize(1, rng.columns.count - 1).address(, , xlr1c1)                     .applydatalabels autotext:=true, legendkey:=false, _                         hasleaderlines:=true, showseriesname:=false, _                         showcategoryname:=false, showvalue:=true, _                         showpercentage:=true, showbubblesize:=false, _                         separator:="" & chr(13) & ""                 end             next         end     end if     end     datarow = datarow + 1     loop     end sub 

***working code***

sub forecastscharts()          dim chtob chartobject         dim lw long         dim rng range         dim rngtocover range         dim sshapename string         dim shtrng range         dim long         dim rowindex long         dim ad worksheet         dim col long         dim datarow long         dim rw long         dim bottomb integer         dim ws worksheet          application.screenupdating = false          set ad = sheets("portfolio list")          ad.select          bottomb = range("c" & rows.count).end(xlup).row         each rng in ad.range("c8:c" & bottomb)             if rng > 0                 set ws = sheets(rng.value)                  set shtrng = ws.range("b8").currentregion                  'if application.countif(rng, "<>") = rng.columns.count   ' data points required                 ws                     if ws.name = "benefits & credits"                         if application.countif(shtrng, "<>") > 0    ' @ least 1 data point                             .shapes.addchart(left:=48, width:=468, top:=300, height:=300).chart                                 .plotby = xlrows                                 .charttype = xlcolumnclustered                                 rowindex = 2 shtrng.rows.count                                     .seriescollection.newseries                                         'this series name                                         .name = "='" & shtrng.parent.name & "'!" & shtrng.cells(rowindex, 1).address(, , xlr1c1)                                         .values = "='" & shtrng.parent.name & "'!" & shtrng.rows(rowindex).cells(1, 2).resize(1, shtrng.columns.count - 1).address(, , xlr1c1)                                         .xvalues = "='" & shtrng.parent.name & "'!" & shtrng.rows(1).cells(1, 2).resize(1, shtrng.columns.count - 1).address(, , xlr1c1)                                         .applydatalabels autotext:=true, legendkey:=false, _                                         hasleaderlines:=true, showseriesname:=false, _                                         showcategoryname:=false, showvalue:=true, _                                         showpercentage:=true, showbubblesize:=false, _                                         separator:="" & chr(13) & ""                                     end                                 next                             end                         end if                     end if                 end             end if         next rng     end sub 

i know code create graph works, because i've tested single sheet. know following part of script identifies unique values match sheet name works because use in script.

datarow = 8          until cells(datarow, 2).value = "" ' loop through data rows             sheets(cells(datarow, 2).value) ' output go applicable portfolio sheet found in column b 

but problem have when run complete script excel crashes creating "excel cannot complete task available resources. choose less data or close other applications" error message , i've no idea why because pc powerful enough run this.

i have looked @ similar posts on forum, unfortunately they've not been able shed light on problem.

i wondered whether possibly @ please , let me know i'm going wrong

i understood goal as: single chart per sheet exists in all data list

your code creating (as @vba4all suggested) many charts. added:

1. sheetshandled collection hold list of sheets got charts.
2. sheetname hold name of sheet used many times in code.
3. function stringexistsincollection looks sheetname in sheetshandled.

so here fixed code:

sub forecastscharts()      dim chtob chartobject     dim lw long     dim rng range     dim rngtocover range     dim sshapename string     dim shtrng range     dim long     dim rowindex long     dim ad worksheet     dim col long     dim datarow long     dim rw long     dim alldatasheet worksheet      dim sheetshandled new collection 'collection chart references     dim sheetname string ' name of sheet being handled (used many times)      set alldatasheet = sheets("all data")     application.screenupdating = false      datarow = 8      until alldatasheet.cells(datarow, 2).value = "" ' loop through data rows      sheetname = alldatasheet.cells(datarow, 2).value 'name memorised here      if not stringexistsincollection(sheetshandled, sheetname)          sheetshandled.add sheetname 'remember handled sheet          sheets(sheetname) ' output go applicable portfolio sheet found in column b          set rng = .range("b8").currentregion          'if application.countif(rng, "<>") = rng.columns.count   ' data points required          if application.countif(rng, "<>") > 0    ' @ least 1 data point              .shapes.addchart(left:=48, width:=468, top:=300, height:=300).chart                 .plotby = xlrows                 .charttype = xlcolumnclustered                 rowindex = 2 rng.rows.count                     .seriescollection.newseries                         'this series name                         .name = "='" & sheetname & "'!" & rng.cells(rowindex, 1).address(, , xlr1c1)                         .values = "='" & sheetname & "'!" & rng.rows(rowindex).cells(1, 2).resize(1, rng.columns.count - 1).address(, , xlr1c1)                         .xvalues = "='" & sheetname & "'!" & rng.rows(1).cells(1, 2).resize(1, rng.columns.count - 1).address(, , xlr1c1)                         .applydatalabels autotext:=true, legendkey:=false, _                             hasleaderlines:=true, showseriesname:=false, _                             showcategoryname:=false, showvalue:=true, _                             showpercentage:=true, showbubblesize:=false, _                             separator:="" & chr(13) & ""                     end                 next             end         end if         end     end if 'end if not sheet handled     datarow = datarow + 1     loop  end sub  public function stringexistsincollection(byref acollection collection, item string) boolean     stringexistsincollection = false     = 1 acollection.count         if acollection(i) = item             stringexistsincollection = true             exit function         end if     next end function