I need to speed up a Macro that populates data in a table from a row of values

J

JBates

New Member
Joined
Sep 11, 2020
Messages
10
Office Version
  1. 365
Platform
  1. Windows
  2. Web
Please help me speed up this macro.


Sheet13.[C14].Value = Sheet15.[C5].Value
Sheet13.[D14].Value = Sheet15.[D5].Value
Sheet13.[C15].Value = Sheet15.[E5].Value

Sheet13.[E14].Value = Sheet15.[F5].Value
Sheet13.[F14].Value = Sheet15.[G5].Value
Sheet13.[E15].Value = Sheet15.[H5].Value

Sheet13.[G14].Value = Sheet15.[I5].Value
Sheet13.[H14].Value = Sheet15.[J5].Value
Sheet13.[G15].Value = Sheet15.[K5].Value

Sheet13.[I14].Value = Sheet15.[L5].Value
Sheet13.[J14].Value = Sheet15.[M5].Value
Sheet13.[I15].Value = Sheet15.[N5].Value

Sheet13.[C20].Value = Sheet15.[O5].Value
Sheet13.[D20].Value = Sheet15.[P5].Value
Sheet13.[C21].Value = Sheet15.[Q5].Value

Sheet13.[E20].Value = Sheet15.[R5].Value
Sheet13.[F20].Value = Sheet15.[S5].Value
Sheet13.[E21].Value = Sheet15.[T5].Value

Sheet13.[G20].Value = Sheet15.[U5].Value
Sheet13.[H20].Value = Sheet15.[V5].Value
Sheet13.[G21].Value = Sheet15.[W5].Value

Sheet13.[I20].Value = Sheet15.[X5].Value
Sheet13.[J20].Value = Sheet15.[Y5].Value
Sheet13.[I21].Value = Sheet15.[Z5].Value

Sheet13.[C26].Value = Sheet15.[AA5].Value
Sheet13.[D26].Value = Sheet15.[AB5].Value
Sheet13.[C27].Value = Sheet15.[AC5].Value

Sheet13.[E26].Value = Sheet15.[AD5].Value
Sheet13.[F26].Value = Sheet15.[AE5].Value
Sheet13.[E27].Value = Sheet15.[AF5].Value

Sheet13.[G26].Value = Sheet15.[AG5].Value
Sheet13.[H26].Value = Sheet15.[AH5].Value
Sheet13.[G27].Value = Sheet15.[AI5].Value

Sheet13.[I26].Value = Sheet15.[AJ5].Value
Sheet13.[J26].Value = Sheet15.[AK5].Value
Sheet13.[I27].Value = Sheet15.[AL5].Value
 
Sort by date Sort by votes
This is sheet13, the green cells will be filled with values from sheet15.
Doubt: the cells in yellow contain formulas?

varios 07feb2022.xlsm
BCDEFGHIJK
13
14xxxxxxxx
15xxxx
16
17
18
19
20xxxxxxxx
21xxxx
22
23
24
25
26xxxxxxxx
27xxxx
28
Sheet13
 
Upvote 0
Rows 16,22,28 have formulas I need to keep from getting over written
 
Upvote 0
I assume that every time you pass a value from one sheet to another, the calculations are updated.
Let's see if the time is reduced, if you pass all the values and then update the calculations of the whole sheet.
Try this:

VBA Code: 
Sub test1()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Sheet13.[C14].Value = Sheet15.[C5].Value
  Sheet13.[D14].Value = Sheet15.[D5].Value
  Sheet13.[C15].Value = Sheet15.[E5].Value
  
  Sheet13.[E14].Value = Sheet15.[F5].Value
  Sheet13.[F14].Value = Sheet15.[G5].Value
  Sheet13.[E15].Value = Sheet15.[H5].Value
  
  Sheet13.[G14].Value = Sheet15.[I5].Value
  Sheet13.[H14].Value = Sheet15.[J5].Value
  Sheet13.[G15].Value = Sheet15.[K5].Value
  
  Sheet13.[I14].Value = Sheet15.[L5].Value
  Sheet13.[J14].Value = Sheet15.[M5].Value
  Sheet13.[I15].Value = Sheet15.[N5].Value
  
  Sheet13.[C20].Value = Sheet15.[O5].Value
  Sheet13.[D20].Value = Sheet15.[P5].Value
  Sheet13.[C21].Value = Sheet15.[Q5].Value
  
  Sheet13.[E20].Value = Sheet15.[R5].Value
  Sheet13.[F20].Value = Sheet15.[S5].Value
  Sheet13.[E21].Value = Sheet15.[T5].Value
  
  Sheet13.[G20].Value = Sheet15.[U5].Value
  Sheet13.[H20].Value = Sheet15.[V5].Value
  Sheet13.[G21].Value = Sheet15.[W5].Value
  
  Sheet13.[I20].Value = Sheet15.[X5].Value
  Sheet13.[J20].Value = Sheet15.[Y5].Value
  Sheet13.[I21].Value = Sheet15.[Z5].Value
  
  Sheet13.[C26].Value = Sheet15.[AA5].Value
  Sheet13.[D26].Value = Sheet15.[AB5].Value
  Sheet13.[C27].Value = Sheet15.[AC5].Value
  
  Sheet13.[E26].Value = Sheet15.[AD5].Value
  Sheet13.[F26].Value = Sheet15.[AE5].Value
  Sheet13.[E27].Value = Sheet15.[AF5].Value
  
  Sheet13.[G26].Value = Sheet15.[AG5].Value
  Sheet13.[H26].Value = Sheet15.[AH5].Value
  Sheet13.[G27].Value = Sheet15.[AI5].Value
  
  Sheet13.[I26].Value = Sheet15.[AJ5].Value
  Sheet13.[J26].Value = Sheet15.[AK5].Value
  Sheet13.[I27].Value = Sheet15.[AL5].Value
  Application.Calculation = xlCalculationAutomatic
  Calculate
  Application.ScreenUpdating = True

End Sub
 
Upvote 0
Solution
In your code you have 3 blocks, but if you have more than 3, then the following code helps to process more than 3 blocks.


VBA Code: 
Sub test()
  Dim a() As Variant, b() As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long, p As Long
  Dim rng1 As Range, rng2 As Range
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Set rng1 = Sheet13.Range("C14")     'Initial cell in sheet3
  Set rng2 = Sheet15.Range("C5")      'Initial cell in sheet5
  For p = 1 To 3                      'Number of blocks
    Erase a, b
    a = rng1.Resize(2, 8).Value
    b = rng2.Resize(1, 12).Value
    k = 0
    n = 0
    For i = 1 To UBound(b, 2)
      n = n + 1
      If n = 3 Then
        n = 0:      j = 2:  m = k - 1
      Else
        k = k + 1:  j = 1:  m = k
      End If
      a(j, m) = b(1, i)
    Next
    rng1.Resize(UBound(a, 1), UBound(a, 2)).Value = a
    Set rng1 = rng1.Offset(6)
    Set rng2 = rng2.Offset(, 12)
  Next
  
  Application.Calculation = xlCalculationAutomatic
  Calculate
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
DanteAmor said:
I assume that every time you pass a value from one sheet to another, the calculations are updated.
Let's see if the time is reduced, if you pass all the values and then update the calculations of the whole sheet.
Try this:

VBA Code: 
Sub test1()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Sheet13.[C14].Value = Sheet15.[C5].Value
  Sheet13.[D14].Value = Sheet15.[D5].Value
  Sheet13.[C15].Value = Sheet15.[E5].Value
 
  Sheet13.[E14].Value = Sheet15.[F5].Value
  Sheet13.[F14].Value = Sheet15.[G5].Value
  Sheet13.[E15].Value = Sheet15.[H5].Value
 
  Sheet13.[G14].Value = Sheet15.[I5].Value
  Sheet13.[H14].Value = Sheet15.[J5].Value
  Sheet13.[G15].Value = Sheet15.[K5].Value
 
  Sheet13.[I14].Value = Sheet15.[L5].Value
  Sheet13.[J14].Value = Sheet15.[M5].Value
  Sheet13.[I15].Value = Sheet15.[N5].Value
 
  Sheet13.[C20].Value = Sheet15.[O5].Value
  Sheet13.[D20].Value = Sheet15.[P5].Value
  Sheet13.[C21].Value = Sheet15.[Q5].Value
 
  Sheet13.[E20].Value = Sheet15.[R5].Value
  Sheet13.[F20].Value = Sheet15.[S5].Value
  Sheet13.[E21].Value = Sheet15.[T5].Value
 
  Sheet13.[G20].Value = Sheet15.[U5].Value
  Sheet13.[H20].Value = Sheet15.[V5].Value
  Sheet13.[G21].Value = Sheet15.[W5].Value
 
  Sheet13.[I20].Value = Sheet15.[X5].Value
  Sheet13.[J20].Value = Sheet15.[Y5].Value
  Sheet13.[I21].Value = Sheet15.[Z5].Value
 
  Sheet13.[C26].Value = Sheet15.[AA5].Value
  Sheet13.[D26].Value = Sheet15.[AB5].Value
  Sheet13.[C27].Value = Sheet15.[AC5].Value
 
  Sheet13.[E26].Value = Sheet15.[AD5].Value
  Sheet13.[F26].Value = Sheet15.[AE5].Value
  Sheet13.[E27].Value = Sheet15.[AF5].Value
 
  Sheet13.[G26].Value = Sheet15.[AG5].Value
  Sheet13.[H26].Value = Sheet15.[AH5].Value
  Sheet13.[G27].Value = Sheet15.[AI5].Value
 
  Sheet13.[I26].Value = Sheet15.[AJ5].Value
  Sheet13.[J26].Value = Sheet15.[AK5].Value
  Sheet13.[I27].Value = Sheet15.[AL5].Value
  Application.Calculation = xlCalculationAutomatic
  Calculate
  Application.ScreenUpdating = True

End Sub
Click to expand...
I like this method alot!
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question Question
Trying to learn how to loop code
Replies
1
Views
268
mumps
mumps
V
  • Solved
Average Function
Replies
8
Views
445
Peter_SSs
Peter_SSs
C
  • Question Question
Changing conditional formatting for Quarters/months
Replies
3
Views
833
felixstraube
F
B
  • Question Question
Color Rows with Value in it, in all Columns, based on Color of Value in Dropdown List (dynamic)
Replies
5
Views
474
Fluff
Fluff
D
  • Question Question
Run Time 1004 Error
Replies
3
Views
581
Alex Blakenburg
A

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