Macro works on old computer but not on new computer unless you step through (F8)

[baggedf]

I received a new computer
Old computer had Windows 10, Microsoft Excel 2016, 4 processors, 8 gig memory
New computer has Windows 10, Microsoft Excel 2016, 8 processors, 32 gig memory

The macro copies data (after certain criteria is meet) and places it on another sheet in priority order.
I can use F8 and the data tranfers fine but if I just try to run it it copies the first few cells and ends. No errors given.
On my old computer I can run the macro with no problems.

Lines 31-59 is where the problem comes into play (I made that part of the macro Bold)

Sub create_summary2()

Dim s_low, s_high As Integer
'Find lowest Priority Number
s_low = WorksheetFunction.Min(Range("B2:B10000"))
'Find highest priority Number
s_high = WorksheetFunction.Max(Range("B2:B10000"))

'64 Bit Declarations: for example ...
        Private Declare PtrSafe Sub API_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
    #Else
'32 Bit Declarations: for example ...
        Public Declare Sub API_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
    #End If


Sheets("Summary2").Range("A3:ZZ10000").ClearContents
Sheets("Summary2").Range("A3:ZZ10000").ClearFormats

i = 2
cav_priority = s_low
header_row = 2
summary_col = 1
output_row = 3

Application.Wait (Now + TimeValue("00:00:2"))
Application.StatusBar = "Creating Priority List in Summary2 Worksheet"

Application.ScreenUpdating = False

While Range("A" & i).Cells.Value <> ""
  If Range("B" & i).Cells.Value = "Priority" Then
    header_row = i
  End If

  If CStr(Range("B" & i).Cells.Value) = CStr(cav_priority) Then
    While Cells(header_row, summary_col).Value <> ""
      Sheets("Summary2").Cells(output_row, summary_col).Value = Cells(header_row, summary_col).Value
      Cells(header_row, summary_col).Copy
      Sheets("Summary2").Cells(output_row, summary_col).PasteSpecial (xlPasteFormats)
      Sheets("Summary2").Cells(output_row + 1, summary_col).Value = Cells(i, summary_col).Value
      Cells(i, summary_col).Copy
      Sheets("Summary2").Cells(output_row + 1, summary_col).PasteSpecial (xlPasteFormats)
     
      summary_col = summary_col + 1
    Wend
   
    i = 2
    cav_priority = cav_priority + 1
        If cav_priority > s_high Then
            GoTo line99
        End If
       
    output_row = output_row + 2
    summary_col = 1
  End If

  i = i + 1
Wend

line99:
'Get priority 99 separate from others
output_row = output_row + 5
summary_col = 1
i = 2
cav_priority = 99

While Range("A" & i).Cells.Value <> ""
  If Range("B" & i).Cells.Value = "Priority" Then
    header_row = i
  End If

  If CStr(Range("B" & i).Cells.Value) = CStr(cav_priority) Then
    While Cells(header_row, summary_col).Value <> ""
      Sheets("Summary2").Cells(output_row, summary_col).Value = Cells(header_row, summary_col).Value
      Cells(header_row, summary_col).Copy
      Sheets("Summary2").Cells(output_row, summary_col).PasteSpecial (xlPasteFormats)
      Sheets("Summary2").Cells(output_row + 1, summary_col).Value = Cells(i, summary_col).Value
      Cells(i, summary_col).Copy
      Sheets("Summary2").Cells(output_row + 1, summary_col).PasteSpecial (xlPasteFormats)
     
      summary_col = summary_col + 1
    Wend
   
    'i = 2
    'cav_priority = cav_priority + 1
       
    output_row = output_row + 2
    summary_col = 1
  End If

  i = i + 1
Wend

Application.ScreenUpdating = True
Application.CutCopyMode = False

Application.Wait (Now + TimeValue("00:00:1"))
Application.StatusBar = ""

Range("A1").Select
Sheets("Summary2").Select
Range("A1").Cells.Value = "Summary sheet generated at: " & Now

End Sub

 

[mole999]

you havent stated that one is 32 bit and the other 64 bit ?

 

[baggedf]

both computers are running 64-bit with Microsoft Office 32-bit

 

[baggedf]

Both computers have the same:
OS Name: Microsoft Windows 10 Pro
System Type: x64-based PC
Windows Directory: C:\windows
System Directory: C:\windows\system32

 

[baggedf]

I rewrote the macro. There are 18 set of priorities to pull and place on a different worksheet and the old one works fine. The new one does the 1st but the stops as if there are no more. Yes I am using the same file on both machines in case you are wondering.

The new macro is:

Sub Create_Priority_List2()
'
Dim pri_goalrng As Range
Dim pri_rownum, pri_headrow, pri_num, pri_goal, num, pri_row As Integer
Dim LastRow, LastRow2 As Long

pri_num = 1
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow2 = 3

Application.ScreenUpdating = False

Sheets("Summary2").Range("A1:AD200").Clear

Worksheets("Schedule2").Select
Range("B2").Select

Set pri_goalrng = Sheets("Schedule2").Range("B2:B200")
pri_goal = Application.WorksheetFunction.Max(pri_goalrng)



Do While ActiveCell.Row < LastRow + 1
    If ActiveCell.Value = "Priority" Then
        num = ActiveCell.Row
    End If
    If ActiveCell.Value = pri_num Then
        Range("A" & num & ":" & "AC" & num).Copy
            Worksheets("Summary2").Range("A" & LastRow2 & ":" & "AC" & LastRow2).PasteSpecial xlPasteAll
            LastRow2 = LastRow2 + 1
        pri_row = ActiveCell.Row
        Range("A" & pri_row & ":" & "AC" & pri_row).Copy
            Worksheets("Summary2").Range("A" & LastRow2 & ":" & "AC" & LastRow2).PasteSpecial xlPasteAll
            LastRow2 = LastRow2 + 1
        Range("B1").Select
        pri_num = pri_num + 1
    End If

ActiveCell.Offset(1, 0).Select
Loop

Worksheets("Summary2").Range("A1").Value = "Summary sheet generated at: " & Now
Range("A1").Select

Application.ScreenUpdating = True
        
MsgBox ("Done")

End Sub

 

[baggedf]

Here is the result on the old computer (I say old, but the only difference I can find is it has 4 processors & 8 gig memory whereas the New computer has 8 processors and 32 gig memory)

and the New computer gives me this:

Now you can see my problem.

 

[RoryA]

I'd try and avoid all that selecting. Perhaps use something like this (Untested):

Sub Create_Priority_List2()

    Dim pri_num As Long
    pri_num = 1
    
    
    Dim LastRow2 As Long
    LastRow2 = 3
    
    Application.ScreenUpdating = False
    
    Dim SummarySheet As Worksheet
    Set SummarySheet = Sheets("Summary2")
    
    Dim ScheduleSheet As Worksheet
    SummarySheet.Range("A1:AD200").Clear
    
    Set ScheduleSheet = Worksheets("Schedule2")
    
    With ScheduleSheet
        Dim LastRow As Long
        LastRow = .UsedRange.Rows.Count
        
        Dim CurrentCell As Range
        Set CurrentCell = .Range("B2")
        
        Dim pri_goalrng As Range
        Set pri_goalrng = .Range("B2:B200")
        
        Dim pri_goal As Long
        pri_goal = Application.WorksheetFunction.Max(pri_goalrng)
    
        Do While CurrentCell.Row < LastRow + 1
            If CurrentCell.Value = "Priority" Then
                Dim num As Long
                num = CurrentCell.Row
            ElseIf CurrentCell.Value = pri_num Then
                .Range("A" & num & ":" & "AC" & num).Copy SummarySheet.Range("A" & LastRow2)
                LastRow2 = LastRow2 + 1
                Dim pri_row As Long
                pri_row = CurrentCell.Row
                .Range("A" & pri_row & ":" & "AC" & pri_row).Copy SummarySheet.Range("A" & LastRow2)
                LastRow2 = LastRow2 + 1
                Set CurrentCell = .Range("B1")
                pri_num = pri_num + 1
            End If
        
            Set CurrentCell = CurrentCell.Offset(1, 0)
        Loop
        
    End With
    SummarySheet.Range("A1").Value = "Summary sheet generated at: " & Now
    
    Application.ScreenUpdating = True
            
    MsgBox "Done"

End Sub

Just to let you know, if you write this:

Dim pri_rownum, pri_headrow, pri_num, pri_goal, num, pri_row As Integer

only the last variable is actually declared as an Integer; all the others are actually Variant. You have to specify the type for each of them.

 

[baggedf]

Thank you. That code worked great. Any idea why it works on both, while the other (we have used for years) would not work on the new computer?

 

[RoryA]

Not really, to be honest. The original code you posted wouldn’t even compile so I don’t know how that ever worked.

 

[baggedf]

Yes, I agree. I did not write the original and it took 3-4 minutes to run because it was copying one cell at a time. The newer computer would paste the first two cells and stop. The code I wrote it would only copy the first copy of rows. Its like it would not loop after going through the code once.

You code was perfect. I like getting away from .Select which I know slows the macro down. Thank you again.