check code

hmaes

New Member
Joined
Jan 16, 2016
Messages
19
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!
VBA Code:
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
 

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,263
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,972
Messages
5,621,908
Members
415,865
Latest member
pxmike

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top