0
\$\begingroup\$

I want to increase the performance of this code:

Dim...
...
...
...
...


Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

Set wb = objExcel.Workbooks.Open("C:\Dateipfad\Dateiname.xlsx", True)
Set rs = db.OpenRecordset("Select DataPointVID from My_ValidReport", dbOpenSnapshot)

Do Until rs.EOF = True
    For Each ws In wb.Worksheets
        Set ValidMeldeposition = ws.UsedRange.Cells.Find(What:=rs!DataPointVID)
        If Not (ValidMeldeposition Is Nothing) Then ValidMeldeposition.Interior.ColorIndex = 43
    Next ws
    rs.MoveNext
Loop

j = 0
Do While Dir(Dokumentenpfad) <> ""
    j = j + 1
    Dokumentenpfad = CurrentProject.Path & "\Dateiname" & Format(Date, " dd.mm.yyyy") & " (" & j & ")" & ".xlsx"
Loop

NeuerReport = Dokumentenpfad

wb.SaveCopyAs (NeuerReport)
MsgBox "Your file was saved here: " & vbCrLf & "'" & NeuerReport & "'"
objExcel.Visible = True

Set objWorkbook = Nothing
Set objExcel = Nothing

End Sub

The problem is that the Excel file contains over 70 Worksheets and every Sheet includes ID's which are checked by the code and also by the Access-Query which includes the ID's.

\$\endgroup\$
2
  • \$\begingroup\$ This sounds like a really fun use case for a 3 dimensional array. I hope you dont mind getting some grey hairs LOL \$\endgroup\$
    – Doug Coats
    Nov 21 '19 at 20:13
  • \$\begingroup\$ what? :D I don't know how i can solve this :D never.. :D \$\endgroup\$
    – Frederic
    Nov 22 '19 at 8:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.