Is it possible to be able to tidy and make my code quicker?

[danbates]

Hi,

I have a list box with the 52 weeks of the year in listed as WK 1, WK 2 and so on up to WK 52.

So when a week is selected from the listbox all the data is copied from that week sheet on to my current weeks data sheet.

Here is part of my code. Its is all the same apart from the week numbers.

Is there any way of making this code better and quicker?

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

If ListBox1.Value = "WK 1" Then

Sheets("Current weeks data").Cells.ClearContents
Sheets("WK 1").Select
ActiveSheet.Rows("1:" & ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row).Copy
Sheets("Current weeks data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select

ElseIf ListBox1.Value = "WK 2" Then

Sheets("Current weeks data").Cells.ClearContents
Sheets("WK 2").Select
ActiveSheet.Rows("1:" & ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row).Copy
Sheets("Current weeks data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select

ElseIf ListBox1.Value = "WK 3" Then

Sheets("Current weeks data").Cells.ClearContents
Sheets("WK 3").Select
ActiveSheet.Rows("1:" & ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row).Copy
Sheets("Current weeks data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select

ElseIf ListBox1.Value = "WK 4" Then

Any help would be appreciated.

Thanks

Dan

 

[jasonb75]

Looking at your code, I think that you might be copying entire rows, not just the columns with data. If that is the case then the extra bloat is probably not helping things.

See if this helps, note that if your weekly sheets are bloated then it will probably still be slow.

In the Current Week sheet, go to what should be the first empty column, select a cell in that column, press Shift Ctrl Right arrow, right click and Delete > Entire Column, then Save. This will remove the bloat that your code has created in the Current Week sheet.

Private Sub CommandButton1_Click()

With Application
    .ScreenUpdating = False
    .Calculation = xlManual

With Sheets("Current weeks data")
    .Cells.ClearContents
    Sheets(ListBox1.Value).UsedRange.Copy
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

    .Calculation = xlAutomatic
    .ScreenUpdating = True
End With

End Sub

 

[danbates]

Hi,

Thank you for your code it does exactly what I had asked for but I was wondering if it was possible to also change the column widths as well with the copied cells?

Thanks again for your help.

Dan

 

[jasonb75]

Probably not going to work too well if you have merged cells or wrapped text, but trying the easiest option first.

Private Sub CommandButton1_Click()

With Application
    .ScreenUpdating = False
    .Calculation = xlManual

With Sheets("Current weeks data")
    .Cells.ClearContents
    Sheets(ListBox1.Value).UsedRange.Copy
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
[COLOR="#FF0000"]    .UsedRange.Columns.Autofit[/COLOR]
End With

    .Calculation = xlAutomatic
    .ScreenUpdating = True
End With

End Sub

 

[danbates]

Hi,

Perfect.

Thank you again for all your help.

Dan