check code

[hmaes]

Hi all,

As a VBA wannabe I'm exploring the internet for everything to make VBA do what I want it to do.
Also I always want to make a better version of my code every time I come up with some new code.
So I want to ask you to have a look at my code and let me know where I can improve.
The code does what it's meant to do but all improvements will be highly appreciated!

Sub RWork()
    
'setup conditions
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
'declare variables to run faster/save memory
    Dim currwb As Workbook
    Dim srcwb As Workbook
    
    Dim LR As Long
    Dim LC As Long
    Dim crosstabLR As Long
    Dim getuserslr As Long
    Dim datarng As Range
    
    Set currwb = ThisWorkbook
    Set srcwb = Workbooks.Open("c:\users\myname\desktop\kpi.xlsx")
    
    
    
'copy source date
    srcwb.Sheets("CrossTab_BR2_KPI").Copy after:=currwb.Sheets("control panel")
    srcwb.Close
    
'activate workfile
    ThisWorkbook.Worksheets("CrossTab_BR2_KPI").Activate
    
'Release memory
    Set srcwb = Nothing
    
'Get LR & LC count
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    
'add totals
    Cells(1, LC).Offset(0, 1) = "Totaal"
    For X = 2 To LR
    Cells(X, LC).Offset(0, 1) = Application.Sum(Range(Cells(X, 2), Cells(X, LC)))
    Next X
    
'Copy Add Names
    Cells(1, LC).Offset(0, 2) = "Naam"
    Set srcwb = Workbooks.Open("filepath\all_users.xlsx")
    srcwb.Sheets("get_users").Copy after:=currwb.Sheets("CrossTab_BR2_KPI")
    srcwb.Close
    
    
'Vlookup
    Dim targetws As Worksheet
    Dim dataws As Worksheet
    Set targetws = currwb.Worksheets("crosstab_BR2_kpi")
    Set dataws = currwb.Worksheets("get_users")
    
    targetLR = targetws.Range("A" & Rows.Count).End(xlUp).Row
    dataLR = dataws.Range("A" & Rows.Count).End(xlUp).Row
    Set datarng = dataws.Range("A2:B" & dataLR)
    
    ThisWorkbook.Worksheets("CrossTab_BR2_KPI").Activate
    For y = 2 To targetLR
    On Error Resume Next
    Cells(y, LC).Offset(0, 2) = Application.WorksheetFunction.vlookup( _
    targetws.Range("A" & y).Value, datarng, 2, False)
    Next y
    
    
'delete get_users sheet
    Worksheets("Get_users").Delete
    
'format headers
    formatC = Cells(1, Columns.Count).End(xlToLeft).Column
    With Range(Cells(1, 1), Cells(1, formatC))
    .ClearFormats
    .Interior.ColorIndex = 15
    .Font.Bold = True
    End With
    
    
    
    Worksheets("crosstab_br2_kpi").PrintPreview
    
'screen flicker on
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Many thanks to have a look and add your comments.

Kind regards, Hans

 

[Norie]

Hans

One thing you could try is putting actual formulas in the cells.

That can be done without looping and it's straightforward to replace the formulas with their values using PasteSpecial>Values.