Databases
StackOverflow2013
Postsdbo
POVBA code running horrendously slow
 

Note that there are some explanatory texts on larger screens.

plurals
  1. POVBA code running horrendously slow
    primarykey
    data
    text
    <p>I have a loop that can go on for ages, although the "Enheder" worksheet only has like 10 rows, and the dataset im loadin has maybe 300 rows, it's taking a REALLY long time when I try to import.</p> <pre><code> Public Function ImportData() Dim resultWorkbook As Workbook Dim curWorkbook As Workbook Dim importsheet As Worksheet Dim debugsheet As Worksheet Dim spgsheet As Worksheet Dim totalposts As Integer Dim year As String Dim month As String Dim week As String Dim Hospital As String Dim varType As String Dim numrows As Integer Dim Rng As Range Dim colavg As String Dim timer As String Dim varKey As String year = ImportWindow.ddYear.value month = ImportWindow.ddMonth.value week = "1" varType = ImportWindow.ddType.value Hospital = ImportWindow.txtHospital.value Set debugsheet = ActiveWorkbook.Sheets("Data") Set spgsheet = ActiveWorkbook.Sheets("Spørgsmål") Set depsheet = ActiveWorkbook.Sheets("Enheder") Set resultWorkbook = OpenWorkbook() setResultColVars debugsheet 'set sheets Set importsheet = resultWorkbook.Sheets("Dataset") numrows = debugsheet.UsedRange.Rows.Count 'make sure that the enhed can be found in the importsheet, so the units can be extracted accordingly If Not (importsheet.UsedRange.Find("afdeling") Is Nothing) Then Dim DepColumn Dim aCell DepColumn = importsheet.UsedRange.Find("afdeling").column 'sort importsheet to allow meaningfull row calculations Set aCell = importsheet.UsedRange.Columns(DepColumn) importsheet.UsedRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlYes Dim tempRange As Range Dim SecColumn Dim secRange As Range 'find row ranges for departments Application.ScreenUpdating = False '**Here's the loop that will go on for aaaaaages until I decide to ctrl+pause** For Each c In depsheet.UsedRange.Columns(1).Cells splStr = Split(c.value, "_") If UBound(splStr) = -1 Then ElseIf UBound(splStr) = 0 Then totalposts = totalposts + IterateColumns(GetRowRange(importsheet, DepColumn, splStr(0)), spgsheet, importsheet, debugsheet, year, month, week, Hospital, splStr(0), 0, varType, False) ElseIf UBound(splStr) = 1 And Not (importsheet.UsedRange.Find("afdeling_" &amp; splStr(0)) Is Nothing) Then totalposts = totalposts + IterateColumns(GetRowRange(importsheet, importsheet.UsedRange.Find("afdeling_" &amp; splStr(0)).column, splStr(1)), spgsheet, importsheet, debugsheet, year, month, week, Hospital, splStr(0), splStr(1), varType, False) End If Next Application.ScreenUpdating = True ' go through columns to get total scores totalposts = totalposts + IterateColumns(importsheet.UsedRange, spgsheet, importsheet, debugsheet, year, month, week, Hospital, 0, 0, varType, True) resultWorkbook.Close Saved = True ResultsWindow.lblPoster.Caption = totalposts ImportWindow.Hide ResultsWindow.Show Else MsgBox "Kunne ikke finde afdelingskolonnen. Kontroller at der er er en kolonne med navnet 'afdeling' i dit datasæt" End If End Function Function GetRowRange(sheetRange, column, value) As Range 'check for a valid section column sheetRange.AutoFilterMode = False sheetRange.UsedRange.AutoFilter Field:=column, Criteria1:=value Set GetRowRange = sheetRange.UsedRange.SpecialCells(xlCellTypeVisible) sheetRange.AutoFilterMode = False End Function 'iterates through columns of a range to get the averages based on the column headers Function IterateColumns(varRange As Range, spgsheet, importsheet, resultsheet, year, month, week, Hospital, dep, sec, varType, sortspg As Boolean) Dim numrows Dim totalposts Dim usedRng totalposts = 0 numrows = resultsheet.UsedRange.Rows.Count Dim insert insert = True If Not (varRange Is Nothing) Then ' go through columns to get scores For i = 1 To varRange.Columns.Count Dim tempi tempi = numrows + totalposts + 1 Set Rng = varRange.Columns(i) With Application.WorksheetFunction 'make sure that the values can calculate If (.CountIf(Rng, "&lt;3") &gt; 0) Then colavg = .SumIf(Rng, "&lt;3") / .CountIf(Rng, "&lt;3") insert = True Else insert = False End If End With 'key is the variable varKey = importsheet.Cells(1, i) 'only add datarow if the data matches a spg, and the datarow is not actually a department If (sortSpgs(varKey, spgsheet, sortspg)) And (insert) And Not (InStr(key, "afdeling")) Then resultsheet.Cells(tempi, WyearCol).value = year resultsheet.Cells(tempi, WmonthCol).value = month resultsheet.Cells(tempi, WweekCol).value = "1" resultsheet.Cells(tempi, WhospCol).value = "Newport Hospital" resultsheet.Cells(tempi, WdepCol).value = "=VLOOKUP(N" &amp; tempi &amp; ",Enheder!$A:$B,2,0)" resultsheet.Cells(tempi, WsecCol).value = "=IFERROR(VLOOKUP(O" &amp; tempi &amp; ",Enheder!$A:$B,2,0),"" "")" resultsheet.Cells(tempi, WdepnrCol).value = dep resultsheet.Cells(tempi, WsecnrCol).value = dep &amp; "_" &amp; sec resultsheet.Cells(tempi, WjtypeCol).value = varType resultsheet.Cells(tempi, WspgCol).value = varKey resultsheet.Cells(tempi, WsporgCol).value = "=VLOOKUP(H" &amp; tempi &amp; ",Spørgsmål!$D:$I,6,0)" resultsheet.Cells(tempi, WtestCol).value = "" resultsheet.Cells(tempi, Wsv1Col).value = colavg resultsheet.Cells(tempi, Wsv2Col).value = (1 - colavg) resultsheet.Cells(tempi, Wsv3Col).value = "" resultsheet.Cells(tempi, WgrpCol).value = "=VLOOKUP(H" &amp; tempi &amp; ",Spørgsmål!$D:$I,4,0)" totalposts = totalposts + 1 End If Next End If IterateColumns = totalposts End Function 'Function that gets the workbook for import Function OpenWorkbook() Dim pathString As String Dim resultWorkbook As Workbook pathString = Application.GetOpenFilename(fileFilter:="All Files (*.*), *.*") ' check if it's already opened For Each wb In Workbooks If InStr(pathString, wb.Name) &gt; 0 Then Set resultWorkbook = wb Exit For End If Next wb If Not found Then Set resultWorkbook = Workbooks.Open(pathString) End If Set OpenWorkbook = resultWorkbook End Function 'find column numbers for resultsheet instead of having to do this in every insert Function setResultColVars(rsheet) WyearCol = rsheet.UsedRange.Find("År").column WmonthCol = rsheet.UsedRange.Find("Måned").column WweekCol = rsheet.UsedRange.Find("Uge").column WhospCol = rsheet.UsedRange.Find("Hospital").column WdepCol = rsheet.UsedRange.Find("Afdeling").column WsecCol = rsheet.UsedRange.Find("Afsnit").column WdepnrCol = rsheet.UsedRange.Find("Afdelingsnr").column WsecnrCol = rsheet.UsedRange.Find("Afsnitnr").column WjtypeCol = rsheet.UsedRange.Find("Journaltype").column WspgCol = rsheet.UsedRange.Find("spg").column WsporgCol = rsheet.UsedRange.Find("spørgsmål").column WtestCol = rsheet.UsedRange.Find("test").column Wsv1Col = rsheet.UsedRange.Find("Svar 1").column Wsv2Col = rsheet.UsedRange.Find("Svar 0").column Wsv3Col = rsheet.UsedRange.Find("Svar 3").column WgrpCol = rsheet.UsedRange.Find("Gruppering").column End Function Function sortSpgs(key, sheet, sortspg As Boolean) If Not (sheet.UsedRange.Find(key) Is Nothing) Then If (sortspg) Then ResultsWindow.lstGenkendt.AddItem key End If sortSpgs = True Else If (sortspg) Then ResultsWindow.lstUgenkendt.AddItem key End If sortSpgs = False End If End Function Function Progress() iProgress = iProgress + 1 Application.StatusBar = iProgress &amp; "% Completed" End Function </code></pre>
    singulars
    1. PO
      singulars
      1. PTAnswer
    1. This table or related slice is empty.
    1. PTQuestion
    1. USJakob
    1. USJakob
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. PO
      singulars
      1. PTAnswer
    2. PO
      singulars
      1. PTAnswer
    1. This table or related slice is empty.
    1. COHej @Jakob! Very difficult to debug that much code without the source files! Can you share? Also, try debugging for yourself by stepping through the code with `F8` and `Shift`-`F8`. My guess is that `UsedRange` returns more rows/columns than you expect...
      singulars
      1. POVBA code running horrendously slow
      1. USPeter Albert
    2. COYou could benefit from using more `With` blocks. For instance you reference `resultsheet...` about 15 times in the 'IterateColumns` function. Each time you call this object, Excel has to load the entire sheet in to memory. Same thing with `SetResultColVars` where you reference `rSheet` multiple times.
      singulars
      1. POVBA code running horrendously slow
      1. USDavid Zemens
 

Querying!

 
Guidance
A row detail

Detail views are divided into sections. All the information in the data section comes from columns in the selected row. The other sections display data from other, related rows.

Related data can be related in a to-one or a to-many fashion. Captions of data related in a to-many fashion link to a list view showing a filtered view of the table.

Try moving around until you find a non-empty to-many entry and click on the label to get to one. You can move back to the root by clicking on the database name in the header.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload