0

I am trying to create a table subset from a larger table. I'm pulling data from certain columns based on data that is filtered so everything up till the first blank row is reached is copied and pasted on a new sheet. Ideally I would like to create a specific type of formatted table, but for now I'm trying to copy the same format as the main table but excel seems to run very repetitively and I'm wondering if its because of redundancies.

Sub Lists()
Dim i As Integer 'define variables, i is a counter, K is a counter, c is an array to hold the values of column numbers to be coppied
'Dim k As Integer ****this variable is no longer needed with this new code of including the formating
'k = 2 'initialize value of counter k the value needed is 2 because the loop does not handle the first element, this is hard coded *** no longer needed with new formatting code

Dim c As Variant 'this variable holds the column numbers to be copied
c = Array(1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 24, 25)

Dim lNumElements As Long ' this varibale will hold the number of elements in array c
lNumElements = UBound(c) - LBound(c) + 1 'this is a formula for the number of elemnts in variable c

Dim NAME As String
NAME = InputBox("Please name the sheet") 'here the user can choose the name of the new worksheet that they wish to write the new table to

Dim ws As Worksheet 'declare a new worksheet to me made
Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'code used to add a new work sheet
ws.NAME = NAME  'use the name from the user input to rename the worksheet

Worksheets("Database").Select 'select the database worksheet
Worksheets("Database").Range("A1").Activate 'place the curser on the A1 range of database

'Sheets("Database").Columns(1).Copy Destination:=Sheets(ws.NAME).Columns(1) ' copy from database sheet and paste to new sheet hard coded for column 1 as the for loop did not like having column one in it as well *** no longer needed with new code
Sheets("Database").Columns(1).Copy 'copy the first column ( column A)
Worksheets(NAME).Select 'choose where you want to copy the data to on the new page
Worksheets(NAME).Range("A1").Activate 'activate the section you choose to copy to in the previous line of code
Selection.PasteSpecial Paste:=xlPasteValues  'paste the values of the code you wanted
Selection.PasteSpecial Paste:=xlPasteFormats 'keep the formating of the code you pasted



For i = 1 To lNumElements - 1 'this for loop will cycle through the number of elements in array c except for the first element
'Sheets("Database").Columns(c(i)).Copy Destination:=Sheets(ws.NAME).Columns(k) ' copy from database sheet and paste to new sheet excluding element 1).  Paste information starting in column 2 (column 1 is hard coded above)

Worksheets("Database").Select
Columns(c(i)).Activate
Sheets("Database").Columns(c(i)).Copy
Worksheets(NAME).Select
Columns(i + 1).Activate

Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats

k = k + 1
Next i

End Sub
Brian Tompsett - 汤莱恩
  • 5,753
  • 72
  • 57
  • 129
ThomasTcred
  • 39
  • 1
  • 6
  • 1
    You could try first to not select the whole columns, but only the range you're interested in. Also avoid "select" whenever possible. see http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros for info. With these two steps you'll probably speed your macro by a factor of ten. – P. O. Feb 01 '17 at 18:37
  • `ScreenUpdating = False` may help. But first, just remove all the `Select` and `Activate` statements. If it's still slow due to calculation, disable automatic calculation during the `for` loop. – UndeadBob Feb 01 '17 at 18:44
  • @reasra but if i have to remove the select and activate statements i somehow still need to copy the data and paste it into the new sheet, i haven't figured out yet how to complete that with other code not involving the select and activate method. – ThomasTcred Feb 01 '17 at 22:45
  • Just set the .Value of the destination to the .Value of the source. Can't find the back quote mark on this phone to format correctly right now. – UndeadBob Feb 02 '17 at 03:39
  • Apologies about the very delayed response, but i tried out the code @reasra, it turns out everything in the column is copied instead of just the filtered rows into the new sheet? Any help would still be appreciated. – ThomasTcred Feb 27 '17 at 17:26
  • Original question made no mention of only wanting to copy _only_ filtered data. See [this answer](http://stackoverflow.com/questions/10849177/easiest-way-to-loop-through-a-filtered-list-with-vba) to check out the `range.SpecialCells(xlCellTypeVisible)`. Use that to determine whether or not to copy the value. – UndeadBob Mar 02 '17 at 19:09
  • I was not able to make the new code work with that range.special, but 20 seconds of waiting is still better than completing the task manually as I previously did so I shall keep using it. Thanks for the attempt to help!! – ThomasTcred Mar 03 '17 at 20:52

3 Answers3

0

Try this and see if it helps:

Disable Sheet Screen Updating

Application.ScreenUpdating = False

‘Place your macro code here

Application.ScreenUpdating = True
Anand
  • 363
  • 2
  • 13
  • Hi @Anand this does help reduce the screen movement back and forth but it still seems to take a lot of processing before the code is execute and take rather long to execute. Thanks though, it still is an improvement in comparison. – ThomasTcred Feb 01 '17 at 23:15
0

If your workbook has a lot of formulas or event macros that could slow it down significantly. Try the magic four:

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.Cursor = xlWait

' Your code

Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
zaphodalive
  • 203
  • 1
  • 7
0

Try this instead of copy+paste:

Worksheets(NAME).Activate 'Just to watch it happen
For i = 1 To lNumElements - 1
    Sheets(NAME).Columns(i + 1).Value = Sheets("Database").Columns(c(i)).Value
    Sheets(NAME).Columns(i + 1).NumberFormat = Sheets("Database").Columns(c(i)).NumberFormat
k = k + 1
Next i
UndeadBob
  • 1,110
  • 1
  • 15
  • 34