Geacht forum,
mijn spreadsheet heeft circa 100 kolommen en > 25.000 regels.
Van deze data moet een dynamisch dashboard gemaakt worden van een aantal grootheden (ouderdom, backlog, ordervalue etc..) per klant, land, regio.
Als ik dus een bepaalde grootheid kies, dan duurt doorrekenen van deze sheet vanaf 3000 regels vrij veel tijd. Bij 15000 regels duurt het al een minuut of 6.
Ik gebruik eerst een Advanced Filter (dit gaat echt supersnel) en ga dan door de visible rows heen van de sheet.
Weten jullie een snellere methode om deze zaken uit te rekenen?
Bedankt,
mvg,
Aat
mijn spreadsheet heeft circa 100 kolommen en > 25.000 regels.
Van deze data moet een dynamisch dashboard gemaakt worden van een aantal grootheden (ouderdom, backlog, ordervalue etc..) per klant, land, regio.
Als ik dus een bepaalde grootheid kies, dan duurt doorrekenen van deze sheet vanaf 3000 regels vrij veel tijd. Bij 15000 regels duurt het al een minuut of 6.
Ik gebruik eerst een Advanced Filter (dit gaat echt supersnel) en ga dan door de visible rows heen van de sheet.
Weten jullie een snellere methode om deze zaken uit te rekenen?
Bedankt,
mvg,
Aat
Code:
Function GetDetails()
Dim order_id(20000) As String
Dim cst(5000, 7)
Dim inst(250, 7)
Dim reg(10, 7)
Dim prdgrp(50, 7)
Dim iss(50, 8)
Set wso = Sheets(shtOrders)
Set wsd = Sheets(shtDashBoard)
Set wst = Sheets(shtTables)
Set wss = Sheets(shtStartingPoints)
Call GetColumns
ord_count = 0
If Date < DateValue("1-4-" & Year(Date)) Then
edate = DateValue("1-4-" & Year(Date))
Else
edate = DateValue("1-4-" & Year(Date) + 1)
End If
Set RNG = wso.Range("A1").CurrentRegion.Columns(wipCol)
If RNG.SpecialCells(xlCellTypeVisible).Cells.Count = 2 Then Exit Function
Set RNG = RNG.Offset(2, 0).Resize(RNG.Rows.Count - 2, RNG.Columns.Count)
For Each r In RNG.SpecialCells(xlCellTypeVisible)
wip = wso.Cells(r.Row, wipCol)
mddr = wso.Cells(r.Row, mddrCol)
ordt = wso.Cells(r.Row, ordtrCol)
ncsr = wso.Cells(r.Row, ncsrCol)
accs = wso.Cells(r.Row, accsCol)
cpes = wso.Cells(r.Row, cpesCol)
pes = wso.Cells(r.Row, pesCol)
tts = wso.Cells(r.Row, ttrCol)
rfss = wso.Cells(r.Row, rfsrCol)
issues = wso.Cells(r.Row, issCol)
ord_id = CStr(wso.Cells(r.Row, ordidCol))
customer = wso.Cells(r.Row, custCol)
city = wso.Cells(r.Row, cityCol)
instc = wso.Cells(r.Row, instCol)
region = wso.Cells(r.Row, regCol)
prodgrp = wso.Cells(r.Row, prodgrpCol)
ordervalue = Val(wso.Cells(r.Row, ordvCol))
FirstBilling = Val(wso.Cells(r.Row, fbillCol))
vfy = wso.Cells(r.Row, vfyCol)
CCD = Format(wso.Cells(r.Row, ccdCol), "mm-yyyy")
mdd = wso.Cells(r.Row, mddCol)
clsdd = wso.Cells(r.Row, clsbtCol)
issue = wst.Range(ftDelay)
issue = Replace(issue, "=", "")
issue = Trim(Replace(issue, "*", ""))
Set C = wss.Range(tblRemoveFromDashBoard).CurrentRegion.Find(customer, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not C Is Nothing Then GoTo nxtr
'Exclude double order id's
If ctDouble Then
For nn = 1 To ord_count
If order_id(nn) = ord_id & instc & city Then GoTo nxtr
Next
ord_count = ord_count + 1
order_id(ord_count) = ord_id & instc & city
End If
totord = totord + 1
totvalue = totvalue + ordervalue
totlt = totlt + wip
totfb = totfb + FirstBilling
If mddr = "Backlog" Then totbl = totbl + ordervalue
totvfy = totvfy + vfy
'Customer
For X = 1 To nc
If cst(X, 1) = customer Then
cst(X, 2) = cst(X, 2) + 1
cst(X, 3) = cst(X, 3) + ordervalue
cst(X, 4) = cst(X, 4) + FirstBilling
cst(X, 5) = cst(X, 5) + wip
If mddr = "Backlog" Then cst(X, 6) = cst(X, 6) + ordervalue
cst(X, 7) = cst(X, 7) + vfy
GoTo nxt1
End If
Next
nc = nc + 1
cst(nc, 1) = customer
cst(nc, 2) = 1
cst(nc, 3) = ordervalue
cst(nc, 4) = FirstBilling
cst(nc, 5) = wip
If mddr = "Backlog" Then cst(nc, 6) = ordervalue
cst(nc, 7) = vfy
nxt1:
'Install Country
For X = 1 To ni
If inst(X, 1) = instc Then
inst(X, 2) = inst(X, 2) + 1
inst(X, 3) = inst(X, 3) + ordervalue
inst(X, 4) = inst(X, 4) + FirstBilling
inst(X, 5) = inst(X, 5) + wip
If mddr = "Backlog" Then inst(X, 6) = inst(X, 6) + ordervalue
inst(X, 7) = inst(X, 7) + vfy
GoTo nxt2
End If
Next
ni = ni + 1
inst(ni, 1) = instc
inst(ni, 2) = 1
inst(ni, 3) = ordervalue
inst(ni, 4) = FirstBilling
inst(ni, 5) = wip
If mddr = "Backlog" Then inst(ni, 6) = ordervalue
inst(ni, 7) = vfy
nxt2:
'Region
For X = 1 To nr
If reg(X, 1) = region Then
reg(X, 2) = reg(X, 2) + 1
reg(X, 3) = reg(X, 3) + ordervalue
reg(X, 4) = reg(X, 4) + FirstBilling
reg(X, 5) = reg(X, 5) + wip
If mddr = "Backlog" Then reg(X, 6) = reg(X, 6) + ordervalue
reg(X, 7) = reg(X, 7) + vfy
GoTo nxt3
End If
Next
nr = nr + 1
reg(nr, 1) = region
reg(nr, 2) = 1
reg(nr, 3) = ordervalue
reg(nr, 4) = FirstBilling
reg(nr, 5) = wip
If mddr = "Backlog" Then reg(nr, 6) = ordervalue
reg(nr, 7) = vfy
nxt3:
'Product Group
For X = 1 To np
If prdgrp(X, 1) = prodgrp Then
prdgrp(X, 2) = prdgrp(X, 2) + 1
prdgrp(X, 3) = prdgrp(X, 3) + ordervalue
prdgrp(X, 4) = prdgrp(X, 4) + FirstBilling
prdgrp(X, 5) = prdgrp(X, 5) + wip
If mddr = "Backlog" Then prdgrp(X, 6) = prdgrp(X, 6) + ordervalue
prdgrp(X, 7) = prdgrp(X, 7) + vfy
GoTo nxt4
End If
Next
np = np + 1
prdgrp(np, 1) = prodgrp
prdgrp(np, 2) = 1
prdgrp(np, 3) = ordervalue
prdgrp(np, 4) = FirstBilling
prdgrp(np, 5) = wip
If mddr = "Backlog" Then prdgrp(np, 6) = ordervalue
prdgrp(np, 7) = vfy
nxt4:
'Issues
s1 = 1
issues = issues & Chr(10)
s2 = Len(issues)
p1 = 0
While s1 < s2
p1 = p1 + 1
If p1 = 1 Then pfactor = 5
If p1 = 2 Then pfactor = 4
If p1 = 3 Then pfactor = 3
If p1 = 4 Then pfactor = 2
If p1 = 5 Then pfactor = 1
tmp = Mid(issues, s1, InStr(s1, issues, Chr(10)) - s1)
If tmp = "N/A" Then pfactor = 0
s1 = InStr(s1, issues, Chr(10)) + 1
For X = 1 To ns
If iss(X, 1) = tmp Then
iss(X, 2) = iss(X, 2) + 1
iss(X, 3) = iss(X, 3) + ordervalue
iss(X, 4) = iss(X, 4) + FirstBilling
iss(X, 5) = iss(X, 5) + wip
If mddr = "Backlog" Then iss(X, 6) = iss(X, 6) + ordervalue
iss(X, 7) = iss(X, 7) + pfactor
iss(X, 8) = iss(X, 8) + vfy
GoTo nxt5
End If
Next
If issue = "" Then
ns = ns + 1
iss(ns, 1) = tmp
iss(ns, 2) = 1
iss(ns, 3) = ordervalue
iss(ns, 4) = FirstBilling
iss(ns, 5) = wip
If mddr = "Backlog" Then iss(ns, 6) = ordervalue
iss(ns, 7) = pfactor
iss(ns, 8) = vfy
Else
If issue = tmp Then
ns = ns + 1
iss(ns, 1) = tmp
iss(ns, 2) = 1
iss(ns, 3) = ordervalue
iss(ns, 4) = FirstBilling
iss(ns, 5) = wip
If mddr = "Backlog" Then iss(ns, 6) = ordervalue
iss(ns, 7) = pfactor
iss(ns, 8) = vfy
End If
End If
nxt5:
Wend
nxtr:
Next
'---------------------------------------------------------------------------------------------------------
'Distri Country
'---------------------------------------------------------------------------------------------------------
Set RNG = wsd.Range(ctDistriDetails)
With RNG
.CurrentRegion.Sort Key1:=RNG, Order1:=xlAscending, header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
'---------------------------------------------------------------------------------------------------------
'Region
'---------------------------------------------------------------------------------------------------------
Set RNG = wsd.Range(ctRegionDetails)
With RNG
.CurrentRegion.ClearContents
.CurrentRegion.EntireColumn.ColumnWidth = 100
.CurrentRegion.EntireColumn.NumberFormat = "#,##0"
.Offset(0, 0) = "Region"
.Offset(0, 1) = "Orders"
.Offset(0, 2) = "Order Value"
.Offset(0, 3) = "Backlog"
.Offset(0, 4) = "First Billing"
.Offset(0, 5) = "Value FY"
.Offset(0, 6) = "Avr Wip"
.Offset(1, 0) = "CIF Control"
.Offset(1, 1) = totord
.Offset(1, 2) = totvalue
.Offset(1, 3) = totbl
.Offset(1, 4) = totfb
.Offset(1, 5) = totvfy
If totord <> 0 Then
.Offset(1, 6) = totlt / totord
End If
For X = 1 To nr
.Offset(X + 1, 0) = reg(X, 1) 'region
.Offset(X + 1, 1) = reg(X, 2) '#orders
.Offset(X + 1, 2) = reg(X, 3) 'Order Value
.Offset(X + 1, 3) = reg(X, 6) 'Back Log
.Offset(X + 1, 4) = reg(X, 4) 'First Billing
.Offset(X + 1, 5) = reg(X, 7) 'value FY
If reg(X, 2) <> 0 Then
.Offset(X + 1, 6) = reg(X, 6) / reg(X, 2)
End If
Next
.CurrentRegion.Sort Key1:=RNG.Offset(0, 1), Order1:=xlDescending, header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.CurrentRegion.Rows(1).Font.Bold = True
.CurrentRegion.Rows(1).EntireColumn.AutoFit
.EntireColumn.ColumnWidth = 16
.Offset(0, -1).EntireColumn.ColumnWidth = 2
End With
'---------------------------------------------------------------------------------------------------------
'Install Country
'---------------------------------------------------------------------------------------------------------
Set RNG = wsd.Range(ctInstDetails)
With RNG
.CurrentRegion.ClearContents
.CurrentRegion.EntireColumn.ColumnWidth = 100
.CurrentRegion.EntireColumn.NumberFormat = "#,##0"
.Offset(0, 0) = "Install Country"
.Offset(0, 1) = "Orders"
.Offset(0, 2) = "Order Value"
.Offset(0, 3) = "Backlog"
.Offset(0, 4) = "First Billing"
.Offset(0, 5) = "Value FY"
.Offset(0, 6) = "Avr Wip"
.Offset(1, 0) = "CIF Control"
.Offset(1, 1) = totord
.Offset(1, 2) = totvalue
.Offset(1, 3) = totbl
.Offset(1, 4) = totfb
.Offset(1, 5) = totvfy
If totord <> 0 Then
.Offset(1, 6) = totlt / totord
End If
For X = 1 To ni
.Offset(X + 1, 0) = inst(X, 1) 'region
.Offset(X + 1, 1) = inst(X, 2) '#orders
.Offset(X + 1, 2) = inst(X, 3) 'Order Value
.Offset(X + 1, 3) = inst(X, 6) 'Back Log
.Offset(X + 1, 4) = inst(X, 4) 'First Billing
.Offset(X + 1, 5) = inst(X, 7) 'Value FY
If inst(X, 2) <> 0 Then
.Offset(X + 1, 6) = inst(X, 5) / inst(X, 2)
End If
Next
.CurrentRegion.Sort Key1:=RNG.Offset(0, 1), Order1:=xlDescending, header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.CurrentRegion.Rows(1).Font.Bold = True
.CurrentRegion.Rows(1).EntireColumn.AutoFit
.EntireColumn.ColumnWidth = 16
.Offset(0, -1).EntireColumn.ColumnWidth = 2
End With
'---------------------------------------------------------------------------------------------------------
'Customer
'---------------------------------------------------------------------------------------------------------
Set RNG = wsd.Range(ctCustDetails)
With RNG
.CurrentRegion.ClearContents
.CurrentRegion.EntireColumn.ColumnWidth = 100
.CurrentRegion.EntireColumn.NumberFormat = "#,##0"
.Offset(0, 0) = "Customer"
.Offset(0, 1) = "Orders"
.Offset(0, 2) = "Order Value"
.Offset(0, 3) = "Backlog"
.Offset(0, 4) = "First Billing"
.Offset(0, 5) = "Value FY"
.Offset(0, 6) = "Avr Wip"
.Offset(1, 0) = "CIF Control"
.Offset(1, 1) = totord
.Offset(1, 2) = totvalue
.Offset(1, 3) = totbl
.Offset(1, 4) = totfb
.Offset(1, 5) = totvfy
If totord <> 0 Then
.Offset(1, 6) = totlt / totord
End If
For X = 1 To nc
.Offset(X + 1, 0) = cst(X, 1) 'region
.Offset(X + 1, 1) = cst(X, 2) '#orders
.Offset(X + 1, 2) = cst(X, 3) 'Order Value
.Offset(X + 1, 3) = cst(X, 6) 'Back Log
.Offset(X + 1, 4) = cst(X, 4) 'First Billing
.Offset(X + 1, 5) = cst(X, 5) 'Value FY
If cst(X, 2) <> 0 Then
.Offset(X + 1, 6) = cst(X, 5) / cst(X, 2)
End If
Next
.CurrentRegion.Sort Key1:=RNG.Offset(0, 1), Order1:=xlDescending, header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.CurrentRegion.Rows(1).Font.Bold = True
.CurrentRegion.Rows(1).EntireColumn.AutoFit
.EntireColumn.ColumnWidth = 16
.Offset(0, -1).EntireColumn.ColumnWidth = 2
End With
'---------------------------------------------------------------------------------------------------------
'Product Group
'---------------------------------------------------------------------------------------------------------
Set RNG = wsd.Range(ctProdGrpDetails)
With RNG
.CurrentRegion.ClearContents
.CurrentRegion.EntireColumn.ColumnWidth = 100
.CurrentRegion.EntireColumn.NumberFormat = "#,##0"
.Offset(0, 0) = "Product Group"
.Offset(0, 1) = "Orders"
.Offset(0, 2) = "Order Value"
.Offset(0, 3) = "Backlog"
.Offset(0, 4) = "First Billing"
.Offset(0, 5) = "Value FY"
.Offset(0, 6) = "Avr Wip"
.Offset(1, 0) = "CIF Control"
.Offset(1, 1) = totord
.Offset(1, 2) = totvalue
.Offset(1, 3) = totbl
.Offset(1, 4) = totfb
.Offset(1, 5) = totvfy
If totord <> 0 Then
.Offset(1, 6) = totlt / totord
End If
For X = 1 To np
.Offset(X + 1, 0) = prdgrp(X, 1) 'product group
.Offset(X + 1, 1) = prdgrp(X, 2) '#orders
.Offset(X + 1, 2) = prdgrp(X, 3) 'Order Value
.Offset(X + 1, 3) = prdgrp(X, 6) 'Back Log
.Offset(X + 1, 4) = prdgrp(X, 4) 'First Billing
.Offset(X + 1, 5) = prdgrp(X, 5) 'Value FY
If prdgrp(X, 2) <> 0 Then
.Offset(X + 1, 6) = prdgrp(X, 5) / prdgrp(X, 2)
End If
Next
.CurrentRegion.Sort Key1:=RNG.Offset(0, 1), Order1:=xlDescending, header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.CurrentRegion.Rows(1).Font.Bold = True
.CurrentRegion.Rows(1).EntireColumn.AutoFit
.EntireColumn.ColumnWidth = 16
.Offset(0, -1).EntireColumn.ColumnWidth = 2
End With
'---------------------------------------------------------------------------------------------------------
'Issues
'---------------------------------------------------------------------------------------------------------
Set RNG = wsd.Range(ctDelayDetails)
With RNG
.CurrentRegion.ClearContents
.CurrentRegion.EntireColumn.ColumnWidth = 100
.CurrentRegion.EntireColumn.NumberFormat = "#,##0"
.Offset(0, 0) = "Issue"
.Offset(0, 1) = "Orders"
.Offset(0, 2) = "Order Value"
.Offset(0, 3) = "Backlog"
.Offset(0, 4) = "First Billing"
.Offset(0, 5) = "Value FY"
.Offset(0, 6) = "Avr Wip"
.Offset(0, 7) = "Weighting"
.Offset(1, 0) = "CIF Control"
.Offset(1, 1) = totord
.Offset(1, 2) = totvalue
.Offset(1, 3) = totbl
.Offset(1, 4) = totfb
.Offset(1, 5) = totvfy
If totord <> 0 Then
.Offset(1, 6) = totlt / totord
End If
For X = 1 To ns
.Offset(X + 1, 0) = iss(X, 1) 'region
.Offset(X + 1, 1) = iss(X, 2) '#orders
.Offset(X + 1, 2) = iss(X, 3) 'Order Value
.Offset(X + 1, 3) = iss(X, 6) 'Back Log
.Offset(X + 1, 4) = iss(X, 4) 'First Billing
.Offset(X + 1, 5) = iss(X, 8) 'Value
If iss(X, 2) <> 0 Then
.Offset(X + 1, 6) = iss(X, 5) / iss(X, 2) 'Average
End If
.Offset(X + 1, 7) = iss(X, 7) 'Weighting
Next
.CurrentRegion.Sort Key1:=RNG.Offset(0, 1), Order1:=xlDescending, header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.CurrentRegion.Rows(1).Font.Bold = True
.CurrentRegion.Rows(1).EntireColumn.AutoFit
.EntireColumn.ColumnWidth = 16
.Offset(0, -1).EntireColumn.ColumnWidth = 2
End With
'-----------------------------------------
'Status Header
'-----------------------------------------
If wst.Range(ftRegion) <> "" Then
st0 = wst.Range(ftRegion) & ", "
ElseIf wst.Range(ftInst) <> "" Then
st0 = wst.Range(ftInst) & ", "
ElseIf wst.Range(ftCust) <> "" Then
st0 = wst.Range(ftCust) & ", "
ElseIf wst.Range(ftProdGrp) <> "" Then
st0 = wst.Range(ftProdGrp) & ", "
ElseIf wst.Range(ftDelay) <> "" Then
st0 = wst.Range(ftDelay) & ", "
End If
If wst.Range(ftOrdertype) = "" Then
st1 = "All Orders, "
Else
st1 = wst.Range(ftOrdertype) & " Orders, "
End If
If wst.Range(ftStatus) = "Progress" Then
st2 = "In Progress, "
ElseIf wst.Range(ftStatus) = "Hold" Then
st2 = "On Hold, "
Else
st2 = "Wip, "
End If
If wst.Range(ftMDD) <> "" Then
st3 = wst.Range(ftMDD)
ElseIf wst.Range(ftDay) <> "" Then
st3 = wst.Range(ftDay) & " Days, "
ElseIf wst.Range(ftVal) <> "" Then
If wst.Range(ftVal) = "=0" Then
st3 = "No Value, "
Else
st3 = wst.Range(ftVal) & "K Euro, "
End If
Else
st3 = ""
End If
If wst.Range(ftDelay) <> "" Then
If wst.Range(ftDelay) <> "N/A" Then
st4 = "Issue: " & wst.Range(ftDelay)
End If
End If
If wst.Range(ftNCSR) <> "" Then
If InStr(wst.Range(ftNCSR), "Not On Time") Then
st4 = "NCSR: Not On Time"
ElseIf InStr(wst.Range(ftNCSR), ">") Then
st4 = "NCSR"
Else
st4 = "NCSR: On Time"
End If
End If
If wst.Range(ftLinkCM) <> "" Then
If wst.Range(ftLinkCM) = "x" Then
st4 = "Link CM"
Else
st4 = "No Link CM"
End If
End If
st = st0 & st1 & st2 & st3 & st4
If Right(st, 2) = ", " Then
st = Left(st, Len(st) - 2)
End If
st = Replace(st, "=", "")
st = Replace(st, "*", "")
wst.Range(ctStatus) = st
wso.Select
Call ChangeWipHdr(wst.Range(ctStatus))
wsd.Select
Call ChangeWipHdr(wst.Range(ctStatus))
errorlog:
End Function
