the following code opens selected files, 1 @ time; if file contains specific text string in b11 (there 4 variation: ls2a, ls1pra, ls1a , lsm12), specified data sheet(1) of each file copied array. search performed function “searchfor” called in main routine.
the array arrcopy filled data each file , should output 1 of 4 sheets in master workbook(sabi, sabii,lsm or lpri&ii). output sheet determined text string in b11 of each file.
i can’t data output master workbook reason. i've tried debug.print each array item after it's filled , can see array filled correct data can't values tranfer master workbook. code runs nothing outputed on worksheet.
please suggest how make work. thanks
option explicit function searchfor(output worksheet) dim rowscount long dim ncbead1 long, ncbead2 long, pcbead1 long, pcbead2 long dim inistring string, inivar string dim rngcell range, rngcell2 range dim arrcopy(1 9) variant dim lastrow long dim acell range lastrow = activesheet.range("b" & rows.count).end(xlup).row 'extract initial after last underscore inistring = activeworkbook.sheets(1).range("b6").value inivar = right(inistring, len(inistring) - instrrev(inistring, "_", , 1)) debug.print inivar 'debug.print "lastrow = " & lastrow set acell = activesheet.range("b1:b" & lastrow).find(what:="trimmed mean", lookin:=xlformulas, _ lookat:=xlpart, searchorder:=xlbyrows, searchdirection:=xlnext, _ matchcase:=false, searchformat:=false) 'debug.print "trimmed mean can found in row # " & acell.row 'wb.sheets(1).select each rngcell in activesheet.range("b" & acell.row & ":b" & lastrow) if instr(rngcell, "nc") > 0 debug.print rngcell.row ncbead1 = rngcell.offset(0, 1).value ncbead2 = rngcell.offset(0, 2).value 'end if exit end if next rngcell each rngcell2 in activesheet.range("b" & acell.row & ":b" & lastrow) if instr(rngcell2, "pc") > 0 debug.print rngcell2.row pcbead1 = rngcell2.offset(0, 1).value pcbead2 = rngcell2.offset(0, 2).value 'end if exit end if next rngcell2 'next searched debug.print ncbead2 arrcopy(1) = activesheet.range("b3").value arrcopy(2) = inivar arrcopy(3) = ncbead1 arrcopy(4) = ncbead2 arrcopy(5) = pcbead1 arrcopy(6) = pcbead2 arrcopy(7) = activesheet.range("b6").value arrcopy(8) = ncbead1 arrcopy(9) = ncbead1 ' 1 row spanning several columns debug.print "arrcopy" & arrcopy(1) debug.print "arrcopy" & arrcopy(2) debug.print "arrcopy" & arrcopy(3) dim destination range set destination = output.range("a" & output.range("a" & rows.count).end(xlup).row + 1) set destination = destination.resize(1, ubound(arrcopy)) destination.value = arrcopy end function sub openselectedfiles() dim savedrivedir string, mypath string, fnameinloop string dim mybook workbook, thiswb workbook dim n long, lstundersc long, extper long, varin long dim fname variant, arrcopy(1 9) variant dim output worksheet dim inls2a boolean, inls1pra boolean, inls1a boolean, inlsm12 boolean set thiswb = thisworkbook ' save current directory. savedrivedir = curdir ' set path folder want open. mypath = application.defaultfilepath ' change drive/directory mypath. chdrive mypath chdir mypath ' open getopenfilename file filters. fname = application.getopenfilename( _ filefilter:="csv files (*.csv),*.csv", _ title:="select file or files", _ multiselect:=true) ' perform action files selected. if isarray(fname) application .screenupdating = false .enableevents = false end n = lbound(fname) ubound(fname) ' file name , test see if open. fnameinloop = right(fname(n), len(fname(n)) - instrrev(fname(n), application.pathseparator, , 1)) if bisbookopen(fnameinloop) = false set mybook = nothing on error resume next set mybook = workbooks.open(fname(n)) on error goto 0 if not mybook nothing mybook.sheets(1).select activesheet.range("b11") inls2a = instr(1, .value, "ls2a", 1) > 0 inls1pra = instr(1, .value, "ls1pra", 1) > 0 inls1a = instr(1, .value, "ls1a", 1) > 0 inlsm12 = instr(1, .value, "lsm12", 1) > 0 end if inls2a set output = thiswb.sheets("sabii") searchfor output elseif inls1pra set output = thiswb.sheets("lpri&ii") searchfor output elseif inls1a set output = thiswb.sheets("sabi") searchfor output elseif inlsm12 set output = thiswb.sheets("lsm") searchfor output end if 'end if mybook.close savechanges:=false set mybook = nothing end if else msgbox "we skipped file : " & fname(n) & " because open." end if next n application .screenupdating = true .enableevents = true end end if ' change drive/directory savedrivedir. chdrive savedrivedir chdir savedrivedir end sub function bisbookopen(byref szbookname string) boolean ' contributed rob bovey on error resume next bisbookopen = not (application.workbooks(szbookname) nothing) end function
Comments
Post a Comment