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.
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
