-1

I have use a code from the internet and customized it for myself, when I run this, which does do what I want it to, it takes for ages and my page seems to jump a lot as its running. It run's through over 2000 rows to find the data.

Any Help to improve this and stop it from jumping would be great

Option Explicit
Sub Stock_Update()

Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim Month As String
Dim frow As Long
Dim i As Integer

Set datasheet = Sheet10
Set reportsheet = Sheet9
Month = reportsheet.Range("c3").Value

reportsheet.Range("A7:l200").ClearContents

datasheet.Select
frow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 7 To frow
If Cells(i, 1) = Month Then
Range(Cells(i, 2), Cells(i, 12)).Copy
reportsheet.Select

Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

datasheet.Select

End If


Next i

reportsheet.Select

Range("A6").Select

End Sub
Julez
  • 3
  • 2

1 Answers1

0

The reason why your screen is flickering is the constant use of select between the two sheets. In general you can avoid this by using application.screenuptdating = false.

But in the end you should avoid selecting at all - please read How to avoid select.

If you only need the values to be copied, you don't need copy/paste actions. This will increase performance too.

I updated your code - with both scenarios possible (copying values only or - as you did - copying formulas and numberformatting as well - just switch the the comment accordingly

Option Explicit

Private Const MonthRange As String = "C3"
Private Const rowStartReport As Long = 7

Public Sub createMonthlyReport()

ApplicationScreenUpdating = False

Dim wsData As Worksheet
Dim wsReport As Worksheet

Set wsData = Sheet10   'you can set the (code)name in the VBA-Editor - then you wouldn't need this
Set wsReport = Sheet9

Dim Month As String

With wsReport
    Month = wsReport.Range(MonthRange).Value
    wsReport.Cells(rowStartReport, 1).CurrentRegion.ClearContents
End With
    

Dim iRowData As Long, iRowReport As Long

Dim r As Range, rgToCopy As Range, cTarget As Range

For Each r In wsData.UsedRange.Rows
    If r.Cells(1, 1) = Month Then
        Set rgToCopy = r.Cells(, 2).Resize(, 11)    'adjust this to your needs
        Set cTarget = wsReport.Cells(rowStartReport + iRowReport, 1)
        
        'change this to your needs
        'copyValues rgToCopy, cTarget     'this is faster
        copyValuesAndFormats rgToCopy, cTarget   'this copies formulas as well
        
        iRowReport = iRowReport + 1
        
    End If
Next

wsReport.Select

wsReport.Range("A6").Select
Application.ScreenUpdating = True

End Sub

'Two Generic routines to copy values etc.

Private Sub copyValues(rgSource As Range, cTarget As Range)
'this copies values only
With rgSource
    cTarget.Resize(.Rows.Count, .Columns.Count).Value = rgSource.Value
End With
End Sub

Private Sub copyValuesAndFormats(rgSource As Range, cTarget As Range)
'this copies values, formulas and numberformats
rgSource.Copy
cTarget.PasteSpecial xlPasteFormulasAndNumberFormats
End Sub
Ike
  • 9,580
  • 4
  • 13
  • 29