CODEWITHSUNDEEP
vbaexcel
Smeltet
Smeltet

Reputation: 19

VBA excel, a lot of flickering and a bit slow, help me optimize

I have now completed my intended worksheet to accomplish what I want it to do. However, the code seems to be very heavy and my computer screen flickers so that I almost get an epileptic seizure. I am hoping that maybe there is something that can be done, but I need your help in acheiving this.

The "system" consists of two files, a userfile (the one that flickers) and a database file.

When I run either the full update or the "new item only" update, it seems to require extensive resources, which I didnt think would be necessary considering the fairly simple task and number of potential lookups. It is all done from the sheet "Sagsnr." in the "Stackoverflow_dummy.xlsm" file.

I have also written the code beneath, but the complete, but sanitized, files are also available here: https://spaces.hightail.com/space/vSKXs.

I hope you guys can help me optimise this.

Sub Worksheet_UpdateAllItemCostData()

Dim material As Variant
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long, J As Long
Const sPOS As String = "Pos. "

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = ActiveWorkbook

J = 0
lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row

If lr < 21 Then
    Exit Sub
End If

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = False

Set wb2 = ActiveWorkbook

    For I = 21 To lr


            wb1.Sheets("Sagsnr.").Rows("1:1").Copy
            wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
            wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


        material = wb1.Sheets("Sagsnr.").Range("C" & I).Value

    Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)

    If Not material = "" Then

        J = J + 1
        wb1.Sheets("Sagsnr.").Range("A" & I).Value = sPOS & J

    End If

    If Not fndEntry Is Nothing Then

        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value


            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs

        End If

    Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)

        If Not fndEntry Is Nothing Then
        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs

        End If

Next I

wb2.Close
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Worksheet_GetNewItemCostData()

Dim material As String
Dim costingdate As Variant
Dim fndEntry As Range, fndCostDate As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long, J As Long
Const sPOS As String = "Pos. "

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = ActiveWorkbook

J = 0
lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row

If lr < 21 Then
    Exit Sub
End If

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = False

Set wb2 = ActiveWorkbook

    For I = 21 To lr

    wb1.Sheets("Sagsnr.").Rows("1:1").Copy
    wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    material = wb1.Sheets("Sagsnr.").Range("C" & I).Value
    costingdate = wb1.Sheets("Sagsnr.").Range("N" & I).Value

    If Not material = "" Then

        J = J + 1
        wb1.Sheets("Sagsnr.").Range("A" & I).Value = sPOS & J

    End If

    If Not costingdate <> "" Then

        Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)


        If Not fndEntry Is Nothing Then

        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
        End If

        Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)

        If Not fndEntry Is Nothing Then

        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
        End If

    End If

Next I

wb2.Close
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Upvotes: 1

Views: 176

Answers (1)

Slai
Slai

Reputation: 22876

When you use 

wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group

Excel has to find the sheets "Sagsnr." and "Matcost" and the respective ranges in them for each cell that you copy.
What you can do instead, is to save the worksheets and ranges the same way you do for the Workbooks before the loop:

Dim wsTo As Worksheet, wsFrom As Worksheet
Set wsTo = wb1.Sheets("Sagsnr.")
Set wsFrom = wb2.Sheets("Matcost")
Dim rngTo As Range, rngFrom As Range

Then inside the loop:

Set rngTo = wsTo.Range("A" & I)
Set rngFrom = wsFrom.Range("A" & fndEntry.Row)

rngTo(, "B") = rngFrom(, "H")  ' Product group
rngTo(, "E") = rngFrom(, "Q")  ' Available Stock
' ... and add the same for the rest of the columns

What can speed it even more is if you can copy ranges of cells at a time instead of cell by cell.
For example, in your case you can filter the source rows and copy the columns:

Dim materials  ' As Variant
materials = wsTo.Range("C21:C" & lr)
materials = WorksheetFunction.Transpose(materials) 'flips from "vertical" to "horisontal"   
wsFrom.UsedRange.AutoFilter 4, materials, xlFilterValues  ' 4 is column D:D in "Matcost"

' set the copy from and paste to ranges
Set rngFrom = wsFrom.Range("A2:A" & wsFrom.UsedRange.Rows.Count) ' skips the header cells
Set rngTo = wsTo.Range("A21")    ' to paste on row 21

' "rngTo(, "B") = rngFrom(, "H")  ' Product group" becomes:
rngFrom.Columns("H").Copy  ' this will copy only the filtered (visible) cells in column H
rngTo(, "B").PasteSpecial  ' or wsTo.Range("B21").PasteSpecial
' ... and add the same for the rest of the columns 

Application.CutCopyMode = False '"Cancels Cut or Copy mode and removes the moving border"

wsTo.UsedRange.AutoFilter 4 ' optional to clear the filter from column D:D

Upvotes: 1

Related Questions