VBA code running slow

G

Gregm66

Board Regular
Joined
Jan 23, 2016
Messages
170
Hi everyone hopefully this is my final question for today.:)
i have a worksheet called "Fees Paid" that uses data validation in column "B", the user selects a name from the list and all other cells auto populate with matching data.
Columns A, C, D, E, F, G and H, cells G & H are dates.

"Fees Paid" looks at Sheet "Members" to return matching data

My problem is that my code works fine, although once a name has been selected it takes along time to populate the other cells like a minute or so can this code be sped up please see code below..

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  Dim sh As Worksheet, f As Range
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Set sh = Sheets("Members")
    Set f = sh.Range("B:B").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      'cell destination              cell origin
      Cells(Target.Row, "A").Value = sh.Cells(f.Row, "A").Value
      Cells(Target.Row, "C").Value = sh.Cells(f.Row, "C").Value
      Cells(Target.Row, "D").Value = sh.Cells(f.Row, "D").Value
      Cells(Target.Row, "E").Value = sh.Cells(f.Row, "E").Value
      Cells(Target.Row, "F").Value = sh.Cells(f.Row, "F").Value
      Cells(Target.Row, "G").Value = sh.Cells(f.Row, "G").Value
      Cells(Target.Row, "H").Value = sh.Cells(f.Row, "H").Value
    Else
      MsgBox "Member does not exists"
    End If
  End If
  
  ' Auto Date Paid
    Dim Cell As Range


For Each Cell In Target
    If Cell.Column = Range("B:B").Column Then
        If Cell.Value <> "" Then
        Cells(Cell.Row, "G").Value = Int(Now)
    Else
    Cells(Cell.Row, "G").Value = ""
    End If
    End If
Next Cell


' Auto Paid to
    'Dim Cell As Range


For Each Cell In Target
    If Cell.Column = Range("G:G").Column Then
        If Cell.Value <> "" Then
        Cells(Cell.Row, "H").Value = Int(Now + 14)
    Else
    Cells(Cell.Row, "H").Value = ""
    End If
    End If
Next Cell
  
End Sub

Thankyou in advance..
 
Last edited:

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Re: Help with vba code running slow

Put at the start:
Code: 
Application.EnableEvents=False

At the end:
Code: 
Application.EnableEvents=True
 
Upvote 0
Re: Help with vba code running slow

Thankyou for your reply footoo

I am not exactly sure where to put this code as i have tried 3 different places in my code and it is still slow to load..see code adjustment below..

Code: 
Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)


Application.EnableEvents = False


     Dim sh As Worksheet, f As Range
     
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  
  
 'Application.ScreenUpdating = False
 
  
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Set sh = Sheets("Members")
    Set f = sh.Range("B:B").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      'cell destination              cell origin
      Cells(Target.Row, "A").Value = sh.Cells(f.Row, "A").Value
      Cells(Target.Row, "C").Value = sh.Cells(f.Row, "C").Value
      Cells(Target.Row, "D").Value = sh.Cells(f.Row, "D").Value
      Cells(Target.Row, "E").Value = sh.Cells(f.Row, "E").Value
      Cells(Target.Row, "F").Value = sh.Cells(f.Row, "F").Value
      Cells(Target.Row, "G").Value = sh.Cells(f.Row, "G").Value
      Cells(Target.Row, "H").Value = sh.Cells(f.Row, "H").Value
      'Application.ScreenUpdating = True
    Else
      MsgBox "Member does not exists"
      
    End If
  End If
  
  ' Auto Date Paid
    Dim Cell As Range


For Each Cell In Target
    If Cell.Column = Range("B:B").Column Then
        If Cell.Value <> "" Then
        Cells(Cell.Row, "G").Value = Int(Now)
    Else
    Cells(Cell.Row, "G").Value = ""
    End If
    End If
Next Cell


' Auto Paid to
    'Dim Cell As Range


For Each Cell In Target
    If Cell.Column = Range("G:G").Column Then
        If Cell.Value <> "" Then
        Cells(Cell.Row, "H").Value = Int(Now + 14)
    Else
    Cells(Cell.Row, "H").Value = ""
    End If
    End If
    
Next Cell
Application.EnableEvents = True
  
End Sub
 
Upvote 0
Re: Help with vba code running slow

If you have many formulas, wrap your code in this:
Code: 
    Dim enableCalcVal As Boolean
    
    enableCalcVal = Me.EnableCalculation
    Me.EnableCalculation = False
    
[SIZE=3][B]    'your code here[/B][/SIZE]
    
    Me.EnableCalculation = enableCalcVal
 
Upvote 0
Re: Help with vba code running slow

Thanks Thomas,

I may not be to bright with all this code, i have tried both methods with both running in my code, and it still takes longer than normal to load, i would have thaught that it would be instant upon cell "B" having a name selected.

below is the code with the added changes.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)


    
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  Dim enableCalcVal As Boolean
    
    enableCalcVal = Me.EnableCalculation
    Me.EnableCalculation = False
  
  Dim sh As Worksheet, f As Range
  
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Set sh = Sheets("Members")
    Set f = sh.Range("B:B").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
      'cell destination              cell origin
      Cells(Target.Row, "A").Value = sh.Cells(f.Row, "A").Value
      Cells(Target.Row, "C").Value = sh.Cells(f.Row, "C").Value
      Cells(Target.Row, "D").Value = sh.Cells(f.Row, "D").Value
      Cells(Target.Row, "E").Value = sh.Cells(f.Row, "E").Value
      Cells(Target.Row, "F").Value = sh.Cells(f.Row, "F").Value
      Cells(Target.Row, "G").Value = sh.Cells(f.Row, "G").Value
      Cells(Target.Row, "H").Value = sh.Cells(f.Row, "H").Value
      Application.EnableEvents = True
      
    Else
      MsgBox "Member does not exists"
    End If
  End If
  
  
  ' Auto Date Paid
    Dim Cell As Range


For Each Cell In Target
    If Cell.Column = Range("B:B").Column Then
        If Cell.Value <> "" Then
        Cells(Cell.Row, "G").Value = Int(Now)
    Else
    Cells(Cell.Row, "G").Value = ""
    End If
    End If
Next Cell


' Auto Paid to
    'Dim Cell As Range


For Each Cell In Target
    If Cell.Column = Range("G:G").Column Then
        If Cell.Value <> "" Then
        Cells(Cell.Row, "H").Value = Int(Now + 14)
    Else
    Cells(Cell.Row, "H").Value = ""
    Application.ScreenUpdating = True
    Me.EnableCalculation = enableCalcVal
    End If
    End If
Next Cell


  
End Sub

Did i get his wrong somewhere?
 
Upvote 0
Re: Help with vba code running slow

If you have formulas that calculate because your code is changing values of their prcedents, this may speed things up.
The line in red near the top restricts your For Each (in red near the bottom) to a single cell. Is that what you want?
Rich (BB code): 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet, f As Range, calcState, cell As Range
     
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
calcState = Application.Calculation
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
  
If Not Intersect(Target, Range("B:B")) Is Nothing Then
  Set sh = Sheets("Members")
  Set f = sh.Range("B:B").Find(Target.Value, , xlValues, xlWhole)
  If Not f Is Nothing Then
    'cell destination              cell origin
    Cells(Target.Row, "A").Value = sh.Cells(f.Row, "A").Value
    Cells(Target.Row, "C").Value = sh.Cells(f.Row, "C").Value
    Cells(Target.Row, "D").Value = sh.Cells(f.Row, "D").Value
    Cells(Target.Row, "E").Value = sh.Cells(f.Row, "E").Value
    Cells(Target.Row, "F").Value = sh.Cells(f.Row, "F").Value
    Cells(Target.Row, "G").Value = sh.Cells(f.Row, "G").Value
    Cells(Target.Row, "H").Value = sh.Cells(f.Row, "H").Value
    'Application.ScreenUpdating = True
  Else
    MsgBox "Member does not exists"
    
  End If
End If
For Each cell In Target
    If cell.Column = Range("B:B").Column Then
        If cell.Value <> "" Then
        Cells(cell.Row, "G").Value = Int(Now)
    Else
    Cells(cell.Row, "G").Value = ""
    End If
    End If
Next cell
For Each cell In Target
    If cell.Column = Range("G:G").Column Then
        If cell.Value <> "" Then
        Cells(cell.Row, "H").Value = Int(Now + 14)
    Else
    Cells(cell.Row, "H").Value = ""
    End If
    End If
    
Next cell
With Application
    .ScreenUpdating = True
    .Calculation = calcState
    .EnableEvents = True
End With
End Sub
 
Last edited:
Upvote 0
Re: Help with vba code running slow

Try:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim sh As Worksheet, f As Range
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Column = 2 Then
    ' Auto Date Paid
    If Target <> "" Then
        Cells(Target.Row, "G") = Int(Now)
    Else
        Cells(Target.Row, "G").ClearContents
        GoTo e
    End If
    Set sh = Sheets("Members")
    Set f = sh.Range("B:B").Find(Target, , xlValues, xlWhole)
    If Not f Is Nothing Then
        'cell destination              cell origin
        Cells(Target.Row, "A") = sh.Cells(f.Row, "A").Value
        Cells(Target.Row, "C").Resize(, 6) = sh.Cells(f.Row, "C").Resize(, 6).Value
    Else
        MsgBox "Member does not exists"
    End If
' Auto Paid to
ElseIf Target.Column = 7 Then
    If Target <> "" Then
        Cells(Target.Row, "H") = Int(Now + 14)
    Else
        Cells(Target.Row, "H").ClearContents
    End If
End If
e:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
 
Upvote 0
Re: Help with vba code running slow

Hi JoeMo,
Thankyou for the code and adjustments to it, problem solved, that works faster only have a very small wait now that is bearable..
thankyou to everyone that has helped with this problem..

Again i thankyou all so much

Regards
Greg
 
Upvote 0
Re: Help with vba code running slow

Gregm66 said:
Hi JoeMo,
Thankyou for the code and adjustments to it, problem solved, that works faster only have a very small wait now that is bearable..
thankyou to everyone that has helped with this problem..

Again i thankyou all so much

Regards
Greg
Click to expand...
You are welcome - thanks for the reply.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Hide Buttons Selectively
Replies
3
Views
78
dmt32
D
I
  • Question Question
Listbox columns dont alter when i set the width advice please
Replies
4
Views
44
ipbr21054
I
J
  • Question Question
VBA to send multiple emails with multiple attachments
Replies
5
Views
676
6StringJazzer
6StringJazzer
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
306
tixarah
T
M
  • Question Question
What am I doing Wrong?
Replies
6
Views
261
MBarrett
M

Forum statistics

Threads
1,223,910
Messages
6,175,320
Members
452,635
Latest member
laura12345

Share this page

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
Back
Top