Macro makes mistakes when ScreenUpdating etc. = False.

Charleton

New Member
Joined
Aug 30, 2017
Messages
23
Hello,

I have a .xlsm - and if I freeze the screen with code, it makes errors. Everything is run from sheet "Mainscreen".


My issue is it seems by freezing the screen, it does not give me all data. Only 2 of 8 rows it would give me without screen freezing, at most. It works perfectly without issue unless I try to freeze the screen. (This is an isolated part of a much larger project, and everything has been tested ALOT, - I can confirm the data, and the results. I have run it isolated, and in concert, and both ways, it works perfectly until this code is active in this module, or it is called by a subroutine with this code in it.)

Specifically, I have a variant number of rows on a sheet "NOC" with an array of data in columns B:K - B is the index column for my reports.

I need to copy all ranges B:K on this worksheet "NOC" and paste them starting with Row B12 on Worksheet "P5A" Worksheet , which will generally have more than 100 and less than 10000 rows. However, it would be nigh impossible for there to be 500 rows on the same "P5A" form. I also need to get the values from range "L:O" that row in Worksheet "NOC" into the range B5:B8 on the "P5A" worksheet. - This will always be the same for any rows with the same value in Column B, so it only needs to happen before the file is saved. I then need to save a copy of the P5A form into a folder, and blank out the P5A form and do the next one.

My Code works, until it doesn't - for some reason, when I try to add (and later remove, of course) the code to not make the screen change, it fails to capture all lines. It only catches two of eight lines for one value in column B. If I error out this code, it works flawlessly.

Everything works fine until I add in the true and false Application display and screen updating etc.

I would appreciate any help in troubleshooting this annoyance, or helping me streamline my code.


Code:
Public Sub PRODUCE_P5A()
 

'This Code messes up data accuracy???
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
'On Error Resume Next

'----- Works from the "Mainscreen" unless screen is not updating
 
‘Declare Variables
Dim StrINDEX As String ' Column B in all sheets being used
Dim P5ALastRow As Long ' To find last row where Column B has a value in sheet P5A
Dim NOCLastRow As Long ' To find last row where Column B has a value in sheet NOC
Dim i As Integer ' Count for For Next
 
‘Sort NOC worksheet by INDEX – Column B
    ActiveWorkbook.Worksheets("NOC").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("NOC").Sort.SortFields.Add Key:=Range( _
        "B2:B59571"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("NOC").Sort
        .SetRange Range("A1:O59571")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Ready Worksheet "P5A"
Worksheets("P5A").Range("B12:K10000").ClearContents
Worksheets("P5A").Range("B5:B8").ClearContents
 
‘------Create P5A NOC forms------
 
Sheets("NOC").Activate
Cells(2, 2).Select
 
StrINDEX = ActiveCell.Value
 
NOCLastRow = Worksheets("NOC").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row
P5ALastRow = Worksheets(“P5A”).Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row
 
For i = 2 To NOCLastRow + 1
 
P5ALastRow = Worksheets("P5A").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row
 
    If Cells(i, 2) = StrINDEX Then
                Range(Cells(i, 2), Cells(i, 11)).Copy
                 Worksheets("P5A").Range("B" & P5ALastRow + 1).PasteSpecial xlPasteValues
   
    Else
   
                Worksheets("P5A").Range("B5") = Worksheets("NOC").Range("L" & i)
                Worksheets("P5A").Range("B6") = Worksheets("NOC").Range("M" & i)
                Worksheets("P5A").Range("B7") = Worksheets("NOC").Range("N" & i)
                Worksheets("P5A").Range("B8") = Worksheets("NOC").Range("O" & i)
   
                Sheets(P5A).Select
                Application.CutCopyMode = False
   
                Sheets(P5A).Copy
                 ChDir "C:\OPS\P5A"
                 ActiveWorkbook.SaveAs Filename:="C:\OPS\P5A\" & StrINDEX & "-NOC.xlsx", FileFormat:= _
                xlOpenXMLWorkbook, CreateBackup:=False, ReadOnlyRecommended:=True
                ActiveWorkbook.Close
   
                Workbooks("WORKBOOK.xlsm").Activate
                Worksheets("P5A").Range("B12:K1000").ClearContents
                Worksheets("P5A").Range("B5:B8").ClearContents
                Worksheets("NOC").Activate
                Cells(i, 2).Select
                 StrINDEX = ActiveCell.Value
                Range(Cells(i, 2), Cells(i, 11)).Copy
                 Worksheets(“P5A”).Range("B12").PasteSpecial xlPasteValues
   
    End If
   
Next i
 
 
 
   
    End If
   
Next i
 
 
Sheets("Mainscreen").Activate

'----- End of Working Code
 

'This Code messes up data accuracy???
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
'On Error Resume Next
 
 
 
End Sub
 
It is always best to post your entire code, unedited.
Otherwise members may end up wasting their time & yours, pointing out errors that don't actually exist.
It can also make it difficult (sometimes impossible) to find the problem, as it might be in part of the code that was removed/modified.
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Ok, fair enough. I just changed everything to be more ambiguous. So - here.

My code, for some reason is working correctly but only when I run it from the VBA window. I have test data, and it appears my real issue is not solved - and is likely an issue with the way I am trying to parse data to my report page. Thanks to anyone who takes a look and can fix this for me! I am happy to answer any questions to help solve this, or to try and do it myself if someone can refer me to a thread where it was already done. (I looked before posting).

If there is a way I can filter the data for each given value in column B and copy it to another sheet, starting at b12, that is what I was trying to do and failed to do, this is just a workaround, and it only works from the vba window.

Code:
Public Sub PRODUCE_P517_NOTICES()

'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
'On Error Resume Next




Dim StrClientID As String ' Column B in all sheets being used
Dim P517ALastRow As Long ' To find last row where Column B has a value in sheet P517A
Dim P517CLastRow As Long ' To find last row where Column B has a value in sheet P517C
Dim P517BLastRow As Long ' To find last row where Column B has a value in sheet P517B
Dim NOCLastRow As Long ' To find last row where Column B has a value in sheet NOC-DATA
Dim LIVELastRow As Long ' To find last row where Column B has a value in sheet LIVE-DATA
Dim CREDLastRow As Long ' To find last row where Column B has a value in sheet CRED-DATA
Dim i As Integer ' Count for For Next








    ActiveWorkbook.Worksheets("NOC-DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("NOC-DATA").Sort.SortFields.Add Key:=Range( _
        "B2:B59571"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("NOC-DATA").Sort
        .SetRange Range("A1:O59571")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("CRED-DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CRED-DATA").Sort.SortFields.Add Key:=Range( _
        "B2:B59571"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CRED-DATA").Sort
        .SetRange Range("A1:O59571")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("LIVE-DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("LIVE-DATA").Sort.SortFields.Add Key:=Range( _
        "B2:B59571"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("LIVE-DATA").Sort
        .SetRange Range("A1:O59571")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With




'P517A OR "Notification of Changes"


Worksheets("P517A").Range("B12:K1000").ClearContents


Sheets("NOC-DATA").Select
Cells(2, 2).Select


StrClientID = ActiveCell.Value


NOCLastRow = Worksheets("NOC-DATA").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row
P517ALastRow = Worksheets("P517A").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row




For i = 2 To NOCLastRow + 1


P517ALastRow = Worksheets("P517A").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row


    If Cells(i, 2) = StrClientID Then
    Range(Cells(i, 2), Cells(i, 11)).Copy
    Worksheets("P517A").Range("B" & P517ALastRow + 1).PasteSpecial xlPasteValues
    
    Else
    
    Worksheets("P517A").Range("B5") = Worksheets("NOC-DATA").Range("L" & i)
    Worksheets("P517A").Range("B6") = Worksheets("NOC-DATA").Range("M" & i)
    Worksheets("P517A").Range("B7") = Worksheets("NOC-DATA").Range("N" & i)
    Worksheets("P517A").Range("B8") = Worksheets("NOC-DATA").Range("O" & i)
    
    Sheets("P517A").Select
    Application.CutCopyMode = False
    
    Sheets("P517A").Copy
    ChDir "C:\AUDITS\P517"
    ActiveWorkbook.SaveAs Filename:="C:\AUDITS\P517\" & StrClientID & "-NotificationOfChanges.xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False, ReadOnlyRecommended:=True
    ActiveWorkbook.Close
    
    Workbooks("P517 WORKBOOK.xlsm").Activate
    Worksheets("P517A").Range("B12:K1000").ClearContents
    Worksheets("NOC-DATA").Select
    Cells(i, 2).Select
    StrClientID = ActiveCell.Value
    Range(Cells(i, 2), Cells(i, 11)).Copy
    Worksheets("P517A").Range("B12").PasteSpecial xlPasteValues
    
    End If
    
Next i






'P517C OR "LIVE RETURNS"


'Sheets("P517C").Activate
Worksheets("P517C").Range("B12:K1000").ClearContents


Sheets("LIVE-DATA").Select
Cells(2, 2).Select


StrClientID = ActiveCell.Value


LIVELastRow = Worksheets("LIVE-DATA").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row
P517CLastRow = Worksheets("P517C").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row




For i = 2 To LIVELastRow + 1


P517CLastRow = Worksheets("P517C").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row


    If Cells(i, 2) = StrClientID Then
    Range(Cells(i, 2), Cells(i, 11)).Copy
    Worksheets("P517C").Range("B" & P517CLastRow + 1).PasteSpecial xlPasteValues
    
    Else
    
    Worksheets("P517C").Range("B5") = Worksheets("LIVE-DATA").Range("L" & i)
    Worksheets("P517C").Range("B6") = Worksheets("LIVE-DATA").Range("M" & i)
    Worksheets("P517C").Range("B7") = Worksheets("LIVE-DATA").Range("N" & i)
    Worksheets("P517C").Range("B8") = Worksheets("LIVE-DATA").Range("O" & i)
    
    Sheets("P517C").Select
    Application.CutCopyMode = False
    
    Sheets("P517C").Copy
    ChDir "C:\AUDITS\P517"
    ActiveWorkbook.SaveAs Filename:="C:\AUDITS\P517\" & StrClientID & "-LiveReturns.xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False, ReadOnlyRecommended:=True
    ActiveWorkbook.Close
    
    Workbooks("P517 WORKBOOK.xlsm").Activate
    Worksheets("P517C").Range("B12:K1000").ClearContents
    Worksheets("LIVE-DATA").Select
    Cells(i, 2).Select
    StrClientID = ActiveCell.Value
    Range(Cells(i, 2), Cells(i, 11)).Copy
    Worksheets("P517C").Range("B12").PasteSpecial xlPasteValues
    
    End If
    
Next i


'P517B Or "CREDIT RETURNS"


'Sheets("P517B").Activate
Worksheets("P517B").Range("B12:K1000").ClearContents


Sheets("CRED-DATA").Select
Cells(2, 2).Select


StrClientID = ActiveCell.Value


CREDLastRow = Worksheets("CRED-DATA").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row
P517BLastRow = Worksheets("P517B").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row




For i = 2 To CREDLastRow + 1


P517BLastRow = Worksheets("P517B").Cells(Rows.Count, 2).End(xlUp).Row ' Find Bottom Row


    If Cells(i, 2) = StrClientID Then
    Range(Cells(i, 2), Cells(i, 11)).Copy
    Worksheets("P517B").Range("B" & P517BLastRow + 1).PasteSpecial xlPasteValues
    
    Else
    
    Worksheets("P517B").Range("B5") = Worksheets("CRED-DATA").Range("L" & i)
    Worksheets("P517B").Range("B6") = Worksheets("CRED-DATA").Range("M" & i)
    Worksheets("P517B").Range("B7") = Worksheets("CRED-DATA").Range("N" & i)
    Worksheets("P517B").Range("B8") = Worksheets("CRED-DATA").Range("O" & i)
    
    Sheets("P517B").Select
    Application.CutCopyMode = False
    
    Sheets("P517B").Copy
    ChDir "C:\AUDITS\P517"
    ActiveWorkbook.SaveAs Filename:="C:\AUDITS\P517\" & StrClientID & "-LiveReturns.xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False, ReadOnlyRecommended:=True
    ActiveWorkbook.Close
    
    Workbooks("P517 WORKBOOK.xlsm").Activate
    Worksheets("P517B").Range("B12:K1000").ClearContents
    Worksheets("CRED-DATA").Select
    Cells(i, 2).Select
    StrClientID = ActiveCell.Value
    Range(Cells(i, 2), Cells(i, 11)).Copy
    Worksheets("P517B").Range("B12").PasteSpecial xlPasteValues
    
    End If
    
Next i




Sheets("Mainscreen").Select




'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
'On Error Resume Next






End Sub
 
Upvote 0
Apart from not being needed removing Select/Activate can simplify something like this.
Code:
Sheets("NOC-DATA").Select
Cells(2, 2).Select


StrClientID = ActiveCell.Value

That can be written in one line.
Code:
StrClientID = Sheets("NOC-DATA").Cells(2,2).Value
 
Upvote 0

Forum statistics

Threads
1,224,753
Messages
6,180,748
Members
452,996
Latest member
nelsonsix66

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