VBA code works but is very slow

S

Stpetebob

New Member
Joined
Nov 7, 2018
Messages
2
I am trying to copy data in Sheet1 to varying cell locations in other sheets within my workbook. Everything works as desired; however, it appears that every bit of code is running every time I enter data. This creates a significant lag in data entry.
How can I speed up the process?
Below is the code I have in Sheet1......

Private Sub Worksheet_Change(ByVal target As Range)
worksheet_change_A target
worksheet_change_B target
worksheet_change_C target
worksheet_change_D target
worksheet_change_E target
worksheet_change_F target
worksheet_change_G target
End Sub
Private Sub worksheet_change_A(ByVal target As Range)
'Tab names
Set target = Range("b12:b19")
If Sheet1.Range("b12").Value = "" Then
Sheet2.Name = "Quote1"
Else
Sheet2.Name = Sheet1.Range("b12").Value
End If
If Sheet1.Range("b13").Value = "" Then
Sheet3.Name = "Quote2"
Else
Sheet3.Name = Sheet1.Range("b13").Value
End If
If Sheet1.Range("b14").Value = "" Then
Sheet4.Name = "Quote3"
Else
Sheet4.Name = Sheet1.Range("b14").Value
End If
If Sheet1.Range("b15").Value = "" Then
Sheet5.Name = "Quote4"
Else
Sheet5.Name = Sheet1.Range("b15").Value
End If
If Sheet1.Range("b16").Value = "" Then
Sheet6.Name = "Quote5"
Else
Sheet6.Name = Sheet1.Range("b16").Value
End If
If Sheet1.Range("b17").Value = "" Then
Sheet7.Name = "Quote6"
Else
Sheet7.Name = Sheet1.Range("b17").Value
End If
If Sheet1.Range("b18").Value = "" Then
Sheet8.Name = "Quote7"
Else
Sheet8.Name = Sheet1.Range("b18").Value
End If
If Sheet1.Range("b19").Value = "" Then
Sheet9.Name = "Quote8"
Else
Sheet9.Name = Sheet1.Range("b19").Value
End If
End Sub

Private Sub worksheet_change_B(ByVal target As Range)
'Schedule number
Set target = Range("d1")
If Sheet1.Range("d1").Value <> "" Then
Sheet2.Range("b1") = Sheet1.Range("d1").Value
Sheet3.Range("b1") = Sheet1.Range("d1").Value
Sheet4.Range("b1") = Sheet1.Range("d1").Value
Sheet5.Range("b1") = Sheet1.Range("d1").Value
Sheet6.Range("b1") = Sheet1.Range("d1").Value
Sheet7.Range("b1") = Sheet1.Range("d1").Value
Sheet8.Range("b1") = Sheet1.Range("d1").Value
Sheet9.Range("b1") = Sheet1.Range("d1").Value
Else
Sheet2.Range("b1") = ""
Sheet3.Range("b1") = ""
Sheet4.Range("b1") = ""
Sheet5.Range("b1") = ""
Sheet6.Range("b1") = ""
Sheet7.Range("b1") = ""
Sheet8.Range("b1") = ""
Sheet9.Range("b1") = ""
End If
End Sub

Private Sub worksheet_change_C(ByVal target As Range)
'Company name
Set target = Range("d2")
If Sheet1.Range("d2").Value <> "" Then
Sheet2.Range("e1") = Sheet1.Range("d2").Value
Sheet3.Range("e1") = Sheet1.Range("d2").Value
Sheet4.Range("e1") = Sheet1.Range("d2").Value
Sheet5.Range("e1") = Sheet1.Range("d2").Value
Sheet6.Range("e1") = Sheet1.Range("d2").Value
Sheet7.Range("e1") = Sheet1.Range("d2").Value
Sheet8.Range("e1") = Sheet1.Range("d2").Value
Sheet9.Range("e1") = Sheet1.Range("d2").Value
Else
Sheet2.Range("e1") = ""
Sheet3.Range("e1") = ""
Sheet4.Range("e1") = ""
Sheet5.Range("e1") = ""
Sheet6.Range("e1") = ""
Sheet7.Range("e1") = ""
Sheet8.Range("e1") = ""
Sheet9.Range("e1") = ""
End If
End Sub

Private Sub worksheet_change_D(ByVal target As Range)
'Job titles
Set target = Range("b12:b19")
If Sheet1.Range("b12").Value <> "" Then
Sheet2.Range("d2") = Sheet1.Range("b12").Value
Sheet3.Range("d2") = Sheet1.Range("b13").Value
Sheet4.Range("d2") = Sheet1.Range("b14").Value
Sheet5.Range("d2") = Sheet1.Range("b15").Value
Sheet6.Range("d2") = Sheet1.Range("b16").Value
Sheet7.Range("d2") = Sheet1.Range("b17").Value
Sheet8.Range("d2") = Sheet1.Range("b18").Value
Sheet9.Range("d2") = Sheet1.Range("b19").Value
Else
Sheet2.Range("d2") = ""
Sheet3.Range("d2") = ""
Sheet4.Range("d2") = ""
Sheet5.Range("d2") = ""
Sheet6.Range("d2") = ""
Sheet7.Range("d2") = ""
Sheet8.Range("d2") = ""
Sheet9.Range("d2") = ""
End If
End Sub

Private Sub worksheet_change_E(ByVal target As Range)
'FT employment count
Set target = Range("f12:f19")
If Sheet1.Range("f12").Value <> "" Then
Sheet2.Range("c3") = Sheet1.Range("f12").Value
Sheet3.Range("c3") = Sheet1.Range("f13").Value
Sheet4.Range("c3") = Sheet1.Range("f14").Value
Sheet5.Range("c3") = Sheet1.Range("f15").Value
Sheet6.Range("c3") = Sheet1.Range("f16").Value
Sheet7.Range("c3") = Sheet1.Range("f17").Value
Sheet8.Range("c3") = Sheet1.Range("f18").Value
Sheet9.Range("c3") = Sheet1.Range("f19").Value
Else
Sheet2.Range("c3") = ""
Sheet3.Range("c3") = ""
Sheet4.Range("c3") = ""
Sheet5.Range("c3") = ""
Sheet6.Range("c3") = ""
Sheet7.Range("c3") = ""
Sheet8.Range("c3") = ""
Sheet9.Range("c3") = ""
End If

End Sub

Private Sub worksheet_change_F(ByVal target As Range)
'PT employment count
Set target = Range("g12:g19")
If Sheet1.Range("g12").Value <> "" Then
Sheet2.Range("e3") = Sheet1.Range("g12").Value
Sheet3.Range("e3") = Sheet1.Range("g13").Value
Sheet4.Range("e3") = Sheet1.Range("g14").Value
Sheet5.Range("e3") = Sheet1.Range("g15").Value
Sheet6.Range("e3") = Sheet1.Range("g16").Value
Sheet7.Range("e3") = Sheet1.Range("g17").Value
Sheet8.Range("e3") = Sheet1.Range("g18").Value
Sheet9.Range("e3") = Sheet1.Range("g19").Value
Else
Sheet2.Range("e3") = ""
Sheet3.Range("e3") = ""
Sheet4.Range("e3") = ""
Sheet5.Range("e3") = ""
Sheet6.Range("e3") = ""
Sheet7.Range("e3") = ""
Sheet8.Range("e3") = ""
Sheet9.Range("e3") = ""
End If

End Sub

Private Sub worksheet_change_G(ByVal target As Range)
'Quote respondent name
Set target = Range("h12:h19")
If Sheet1.Range("h12").Value <> "" Then
Sheet2.Range("n3") = Sheet1.Range("h12").Value
Sheet3.Range("n3") = Sheet1.Range("h13").Value
Sheet4.Range("n3") = Sheet1.Range("h14").Value
Sheet5.Range("n3") = Sheet1.Range("h15").Value
Sheet6.Range("n3") = Sheet1.Range("h16").Value
Sheet7.Range("n3") = Sheet1.Range("h17").Value
Sheet8.Range("n3") = Sheet1.Range("h18").Value
Sheet9.Range("n3") = Sheet1.Range("h19").Value
Else
Sheet2.Range("n3") = ""
Sheet3.Range("n3") = ""
Sheet4.Range("n3") = ""
Sheet5.Range("n3") = ""
Sheet6.Range("n3") = ""
Sheet7.Range("n3") = ""
Sheet8.Range("n3") = ""
Sheet9.Range("n3") = ""
End If
End Sub
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
Do they have to be worksheet_change events ??
It looks like they could be straightforward macros triggered by the user, would that be better ??
 
Upvote 0
Michael M said:
Do they have to be worksheet_change events ??
It looks like they could be straightforward macros triggered by the user, would that be better ??
Click to expand...

It can be anything that provides the results I am looking for. :) I am a complete novice at coding.
I just didn't want to place a formula directly into the receiving cells. If I did, I would have to protect the worksheet to keep the user from inadvertently changing that cell's contents.
I am using a code to change the background color of some cells in the other eight sheets to yellow, when the user "double-clicks" on that cell.
 
Upvote 0
So to give you an idea.....
This.....
Code: 
Private Sub worksheet_change_A(ByVal target As Range)
'Tab names
Set target = Range("b12:b19")
If Sheet1.Range("b12").Value = "" Then
Sheet2.Name = "Quote1"
Else
Sheet2.Name = Sheet1.Range("b12").Value
End If
If Sheet1.Range("b13").Value = "" Then
Sheet3.Name = "Quote2"
Else
Sheet3.Name = Sheet1.Range("b13").Value
End If
If Sheet1.Range("b14").Value = "" Then
Sheet4.Name = "Quote3"
Else
Sheet4.Name = Sheet1.Range("b14").Value
End If
If Sheet1.Range("b15").Value = "" Then
Sheet5.Name = "Quote4"
Else
Sheet5.Name = Sheet1.Range("b15").Value
End If
If Sheet1.Range("b16").Value = "" Then
Sheet6.Name = "Quote5"
Else
Sheet6.Name = Sheet1.Range("b16").Value
End If
If Sheet1.Range("b17").Value = "" Then
Sheet7.Name = "Quote6"
Else
Sheet7.Name = Sheet1.Range("b17").Value
End If
If Sheet1.Range("b18").Value = "" Then
Sheet8.Name = "Quote7"
Else
Sheet8.Name = Sheet1.Range("b18").Value
End If
If Sheet1.Range("b19").Value = "" Then
Sheet9.Name = "Quote8"
Else
Sheet9.Name = Sheet1.Range("b19").Value
End If
End Sub

Can become this...

Code: 
Sub MM1()
Dim n As Integer, r As Long, x As Integer
n = 1
x = 2
For r = 12 To 19
    If Sheet1.Range("b" & r).Value = "" Then
        Worksheets("Sheet" & x).Name = "Quote" & n
        Else
        Worksheets("Sheet" & x).Name = Sheet1.Range("b" & r).Value
    End If
n = n + 1
x = x + 1
Next r
End Sub
 
Last edited:
Upvote 0
Although Michael M's code is neater, I don't think it saves on run-time.

Here's another possibility (assumes changes in the relevant ranges are entered manually) :
Code: 
Private Sub Worksheet_Change(ByVal target As Range)
If Not Intersect(target, [B12:B15]) Is Nothing Then
    worksheet_change_A target
    worksheet_change_D target
ElseIf Not Intersect(target, [D1]) Is Nothing Then
    worksheet_change_B target
'ETC...
End If
End Sub

Also, macro actions could be further reduced with changes such as :
Code: 
Private Sub worksheet_change_A(ByVal target As Range)
'Tab names
Dim cel As Range
Set target = Intersect(Range("b12:b19"), target)
For Each cel In target
    Select Case cel.Address(0, 0)
        Case "B12"
            If cel = "" Then
               Sheet2.Name = "Quote1"
            Else: Sheet2.Name = cel
            End If
        Case "B13"
            If cel = "" Then
               Sheet2.Name = "Quote1"
            Else: Sheet2.Name = cel
            End If
        'ETC....
    End Select
Next
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Getting Macros to run automatically
Replies
3
Views
195
mumps
mumps
R
  • Question
Creating a loop to rename worksheets
Replies
4
Views
404
Micron
M
B
  • Solved
VBA Help - Same Function needed for multiple sheets
Replies
2
Views
226
birdman15
B
J
  • Solved
VBA Project (Automatic Update) and Macro reference with file name change
Replies
8
Views
295
JDSOuth49
J
E
  • Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
269
offthelip
O

Forum statistics

Threads
1,214,622
Messages
6,120,576
Members
448,972
Latest member
Shantanu2024

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