can anyone help me on my code below to simplify... Im not a programmer but i just tried to google everything and record some steps. But if you could help me simply the code below would be very much appreciated.
Sub generate()
dim timestart as date, timeend as date, datedate as date, ds as date, de as date
dim lastrow as long, erow as integer, sheet1 as worksheet, sheet2 as worksheet
dim psheet as worksheet
dim dsheet as worksheet
dim pcache as pivotcache
dim ptable as pivottable
dim prange as range
dim lastcol as long
dim firstrow as long
dim lrow as long
dim calcmode as long
dim viewmode as long
dim i as long
dim r as long, lr as long
dim inta as integer
dim wrksht as excel.worksheet
dim aname as string
timestart = now()
sheets("episodes").select
sheets("target").visible = true
sheets("episodes").select
sheets("roster").visible = true
set wrksht = application.worksheets("source")
inta = 1
do until inta = wrksht.usedrange.rows.count
select case wrksht.cells(inta, "o").value
case "open", "open - new", "open-md review", "open-pending", "open-pending activity", "open-transfer", "closed by onshore", "void - invalid-rework"
wrksht.rows(inta).delete
case else
inta = inta + 1
end select
loop
sheets("target").select
cells.select
selection.clearcontents
set sheet1 = worksheets("source")
set sheet2 = worksheets("target")
lastrow = sheet1.cells(rows.count, 1).end(xlup).row
for i = 1 to lastrow
erow = sheet2.cells(rows.count, 1).end(xlup).offset(1, 1).row
sheet2.cells(erow, 1) = sheet1.cells(i, 1) 'episode_number
sheet2.cells(erow, 2) = sheet1.cells(i, 2) 'sr_number
sheet2.cells(erow, 3) = sheet1.cells(i, 4) 'cts_duedate
sheet2.cells(erow, 4) = sheet1.cells(i, 6) 'request_received_date
sheet2.cells(erow, 5) = sheet1.cells(i, 7) 'fb_age
sheet2.cells(erow, 6) = sheet1.cells(i, 8) 'group_name
sheet2.cells(erow, 7) = sheet1.cells(i, 9) 'reason for referral
sheet2.cells(erow, 8) = sheet1.cells(i, 11) 'client group
sheet2.cells(erow, 9) = sheet1.cells(i, 12) 'duedate_day
sheet2.cells(erow, 10) = sheet1.cells(i, 13) 'allocated to
sheet2.cells(erow, 11) = sheet1.cells(i, 14) 'allocated date
sheet2.cells(erow, 12) = sheet1.cells(i, 15) 'status
sheet2.cells(erow, 13) = sheet1.cells(i, 16) 'gbk code
sheet2.cells(erow, 14) = sheet1.cells(i, 18) 'last updated date
sheet2.cells(erow, 15) = sheet1.cells(i, 19) 'uploaded date
next i
columns("k:k").select
selection.insert shift:=xltoright, copyorigin:=xlformatfromleftorabove
columns("j:j").select
selection.texttocolumns destination:=range("j1"), datatype:=xlfixedwidth, _
fieldinfo:=array(array(0, 1), array(9, 1)), trailingminusnumbers:=true
'columns("k:k").select
columns("j:j").select
selection.replace what:="-", replacement:="", lookat:=xlpart, _
searchorder:=xlbyrows, matchcase:=false, searchformat:=false, _
replaceformat:=false
'-----
' inserts a new column and delimit
columns("m:m").select
selection.insert shift:=xltoright, copyorigin:=xlformatfromleftorabove
columns("l:l").select
selection.texttocolumns destination:=range("l1"), datatype:=xlfixedwidth, _
fieldinfo:=array(array(0, 1), array(11, 1)), trailingminusnumbers:=true
' converts to date
columns("l:l").select
selection.texttocolumns destination:=range("l1"), datatype:=xldelimited, _
textqualifier:=xlsinglequote, consecutivedelimiter:=true, tab:=true, _
semicolon:=false, comma:=false, space:=false, other:=true, otherchar _
:=",", fieldinfo:=array(1, 3), trailingminusnumbers:=true
columns("q:q").select
selection.insert shift:=xltoright, copyorigin:=xlformatfromleftorabove
columns("p
").select
selection.texttocolumns destination:=range("p1"), datatype:=xlfixedwidth, _
otherchar:=",", fieldinfo:=array(array(0, 1), array(12, 1)), _
trailingminusnumbers:=true
selection.texttocolumns destination:=range("p1"), datatype:=xldelimited, _
textqualifier:=xlsinglequote, consecutivedelimiter:=true, tab:=true, _
semicolon:=false, comma:=false, space:=false, other:=true, otherchar _
:=",", fieldinfo:=array(1, 3), trailingminusnumbers:=true
columns("r:r").select
selection.texttocolumns destination:=range("r1"), datatype:=xlfixedwidth, _
otherchar:=",", fieldinfo:=array(array(0, 1), array(12, 1)), _
trailingminusnumbers:=true
selection.texttocolumns destination:=range("r1"), datatype:=xldelimited, _
textqualifier:=xlsinglequote, consecutivedelimiter:=true, tab:=true, _
semicolon:=false, comma:=false, space:=false, other:=false, otherchar _
:=",", fieldinfo:=array(1, 3), trailingminusnumbers:=true
'
' '-------------------stop here
'add headers
range("a1").select
activecell.formular1c1 = "episode number"
range("b1").select
activecell.formular1c1 = "sr number"
range("c1").select
activecell.formular1c1 = "cts due date"
range("d1").select
activecell.formular1c1 = "request received data"
range("e1").select
activecell.formular1c1 = "fb age"
range("f1").select
activecell.formular1c1 = "group name"
range("g1").select
activecell.formular1c1 = "reason for referral"
range("h1").select
activecell.formular1c1 = "client group"
range("i1").select
activecell.formular1c1 = "due date day"
range("j1").select
activecell.formular1c1 = "associate id"
range("k1").select
activecell.formular1c1 = "associates name"
range("l1").select
activecell.formular1c1 = "allocated date"
range("m1").select
activecell.formular1c1 = "aloocated time"
range("n1").select
activecell.formular1c1 = "status"
range("o1").select
activecell.formular1c1 = "gbk code"
range("p1").select
activecell.formular1c1 = "last updated date"
range("q1").select
activecell.formular1c1 = "total work"
range("r1").select
activecell.formular1c1 = "uploaded date"
range("s1").select
activecell.formular1c1 = "uploaded time"
range("t1").select
activecell.formular1c1 = "project manager"
range("u1").select
activecell.formular1c1 = "ops manager"
range("v1").select
activecell.formular1c1 = "closed-overturned"
range("w1").select
activecell.formular1c1 = "closed-upheld"
range("x1").select
activecell.formular1c1 = "closed-md approved"
range("y1").select
activecell.formular1c1 = "void-duplicate"
range("z1").select
activecell.formular1c1 = "void-already paid"
range("aa1").select
activecell.formular1c1 = "void-misroute"
range("ab1").select
activecell.formular1c1 = "productivity"
'---- deletes the row 2 header
rows("2:2").select
selection.delete shift:=xlup
'
' '----- stops here for vlookup associates and project manager
range("t2").select
activecell.formular1c1 = "=vlookup(rc[-10],roster!c[-19]:c[-16],4,0)"
range("t2").select
selection.autofill destination:=range("t2:t30000")
range("t2:t30000").select
range("v4").select
'---- vlookup completed
'--- paste values
'computation here ---
range(selection, selection.end(xltoright)).select
range(selection, selection.end(xldown)).select
selection.numberformat = "0.00"
range("v2").select
activecell.formular1c1 = "=if(rc[-8]=r1c,""1"",""0"")"
range("w2").select
activecell.formular1c1 = "=if(rc[-9]=r1c,""1"",""0"")"
range("x2").select
activecell.formular1c1 = "=if(rc[-10]=r1c,""1"",""0"")"
range("y2").select
activecell.formular1c1 = "=if(rc[-11]=r1c,"".25"",""0"")"
range("z2").select
activecell.formular1c1 = "=if(rc[-12]=r1c,"".25"",""0"")"
range("aa2").select
activecell.formular1c1 = "=if(rc[-13]=r1c,"".25"",""0"")"
range("ab2").select
activecell.formular1c1 = "=sum(rc[-6]:rc[-1])"
selection.numberformat = "0.00"
'autofill to down
range("v2:ab2").select
selection.autofill destination:=range("v2:ab15000")
selection.numberformat = "0.00"
range("v2:ab15000").select
range("v2:aa2").select
range(selection, selection.end(xldown)).select
selection.copy
application.cutcopymode = false
selection.copy
application.cutcopymode = false
selection.copy
range("v2").select
selection.pastespecial paste:=xlpastevalues, operation:=xlnone, skipblanks _
:=false, transpose:=false
'dim lastrow as integer, erow as integer, sheet1 as worksheet, sheet2 as worksheet
'delete preivous pivot table worksheet & insert a new blank worksheet with same name
on error resume next
application.displayalerts = false
worksheets("episodes").delete
sheets.add before:=activesheet
activesheet.name = "episodes"
application.displayalerts = true
set psheet = worksheets("episodes")
set dsheet = worksheets("target")
'
'
'define data range
lastrow = dsheet.cells(rows.count, 1).end(xlup).row
lastcol = dsheet.cells(1, columns.count).end(xltoleft).column
set prange = dsheet.cells(1, 1).resize(lastrow, lastcol)
'define pivot cache
set pcache = activeworkbook.pivotcaches.create _
(sourcetype:=xldatabase, sourcedata:=prange). _
createpivottable(tabledestination:=psheet.cells(2, 2), _
tablename:="episodes")
'insert blank pivot table
set ptable = pcache.createpivottable_
'(tabledestination:=psheet.cells(1, 1), tablename:="salespivottable")
'insert row fields -------------------------------------------
activeworkbook.pivotcaches.create(sourcetype:=xldatabase, sourcedata:= _
"target!r1c1:r18000c21", version:=xlpivottableversion15).createpivottable _
tabledestination:="episodes!r3c1", tablename:="episodes", defaultversion _
:=xlpivottableversion15
sheets("episodes").select
cells(3, 1).select
with activesheet.pivottables("episodes").pivotfields("project manager")
.orientation = xlrowfield
.position = 1
end with
with activesheet.pivottables("episodes").pivotfields("associates name")
.orientation = xlrowfield
.position = 2
end with
activesheet.pivottables("episodes").adddatafield activesheet.pivottables( _
"episodes").pivotfields("total work"), "count of total work", xlcount
'\\\\\
' with activesheet.pivottables("episodes").pivotfields("sum of total work")
' .caption = "count of total work"
' .function = xlcount
' end with
'\\\\
with activesheet.pivottables("episodes").pivotfields("sum of total work")
.caption = "count of total work"
.function = xlcount
end with
activesheet.pivottables("episodes").adddatafield activesheet.pivottables( _
"episodes").pivotfields("productivity"), "count of productivity", xlcount
with activesheet.pivottables("episodes").pivotfields("count of productivity")
.caption = "'productivity"
.function = xlsum
end with
with activesheet.pivottables("episodes").pivotfields("status")
.orientation = xlrowfield
.position = 3
end with
with activesheet.pivottables("episodes").pivotfields("last updated date")
.orientation = xlcolumnfield
.position = 1
end with
with activesheet.pivottables("episodes").pivotfields("client group")
.orientation = xlpagefield
.position = 1
end with
with activesheet.pivottables("episodes").pivotfields("fb age")
.orientation = xlpagefield
.position = 1
end with
with activesheet.pivottables("episodes").pivotfields("group name")
.orientation = xlpagefield
.position = 1
end with
with activesheet.pivottables("episodes").pivotfields("reason for referral")
.orientation = xlpagefield
.position = 1
end with
with activesheet.pivottables("episodes").pivotfields("gbk code")
.orientation = xlpagefield
.position = 1
end with
range("b3").select
activesheet.pivottables("episodes").compactlayoutrowheader = "associates name"
range("c3").select
activesheet.pivottables("episodes").tablestyle2 = "pivotstyledark7"
cells.select
with selection.font
.name = "calibri"
.size = 10
.strikethrough = false
.superscript = false
.subscript = false
.outlinefont = false
.shadow = false
.underline = xlunderlinestylenone
.themecolor = xlthemecolorlight1
.tintandshade = 0
.themefont = xlthemefontnone
end with
activewindow.displaygridlines = false
range("a4").select
activesheet.pivottables("episodes").compactlayoutrowheader = _
"associates name"
range("c3").select
activeworkbook.showpivottablefieldlist = false
range("f5").select
activewindow.freezepanes = true
activewindow.zoom = 85
cells.select
sheets("source").select
application.cutcopymode = false
selection.clearcontents
sheets("episodes").select
cells.entirecolumn.autofit
sheets("target").select
activewindow.selectedsheets.visible = false
sheets("roster").select
activewindow.selectedsheets.visible = false
sheets("source").select
activewindow.selectedsheets.visible = false
'create a workbook
episodes = activeworkbook.sheets(1).range("a1").value
workbooks.add
activeworkbook.saveas filename:=episodes & ".xls"
timeend = now()
msgbox ("completed in " & format(timeend - timestart, "hh:mm:ss") & ".")
end sub