G
Guest
Hi,
I'm running a macro (code below) that separates information about employees
into different worksheets according to their role on a particular project.
The master sheet has about 4200 rows of information, and there are 15
different roles. My problem is that the macro stops executing at about line
1337 on the master data page. It deletes this row and stops executing.
Is there a maximum run time, or is there something funky in my code? I am
obviously only getting through about a third of my data before this macro
quits and it's pretty frustrating.
Thanks
Sub Copy_Select()
Application.ScreenUpdating = False
'Copy and Paste rows from Master List according to the ESM category
'Declare Variables
Dim stRole As String
Dim inMasterRow As Integer 'This is the active row on the Master Sheet
Dim inRow As Integer 'This is the variable used to determine the blank row
on the working sheet
Dim BegAddress 'used to deliver beginning cell address to range functions
Dim EndAddress 'used to deliver end cell address to range functions
Dim stType As String 'Used to control the Do-While loop
Dim stBlank As String ' Used to control the do-while loop that determines
blank rows
'Select first row of the Master worksheet
Worksheets("Engineer Roles Table").Select
inMasterRow = 2
stType = Cells(inMasterRow, 1).Value 'Used to initiate the Do-While loop
Do While stType <> ""
Worksheets("Engineer Roles Table").Select
stRole = Cells(inMasterRow, 5).Value
stType = Cells(inMasterRow, 1).Value
BegAddress = Cells(inMasterRow, 1).Address
EndAddress = Cells(inMasterRow, 9).Address
'Copy data (Select row)
Range(BegAddress & ":" & EndAddress).Copy
'Determine which sheet to paste data according to ESM Status (Select Case)
'Select proper worksheet according to status
'MsgBox ESMStatus 'for auditing
If stRole <> "" Then
Worksheets(stRole).Select
'Find first empty row on the selected sheet
inRow = 1
stBlank = Cells(inRow, 1).Value
Do While stBlank <> ""
inRow = inRow + 1
stBlank = Cells(inRow, 1).Value
Loop
End If
'Paste Data
BegAddress = Cells(inRow, 1).Address
EndAddress = Cells(inRow, 9).Address
Range(BegAddress & ":" & EndAddress).PasteSpecial
'Go to the next row (repeat the ESMStatus Do-While loop until finished)
inMasterRow = inMasterRow + 1
Loop
Application.ScreenUpdating = True
End Sub
I'm running a macro (code below) that separates information about employees
into different worksheets according to their role on a particular project.
The master sheet has about 4200 rows of information, and there are 15
different roles. My problem is that the macro stops executing at about line
1337 on the master data page. It deletes this row and stops executing.
Is there a maximum run time, or is there something funky in my code? I am
obviously only getting through about a third of my data before this macro
quits and it's pretty frustrating.
Thanks
Sub Copy_Select()
Application.ScreenUpdating = False
'Copy and Paste rows from Master List according to the ESM category
'Declare Variables
Dim stRole As String
Dim inMasterRow As Integer 'This is the active row on the Master Sheet
Dim inRow As Integer 'This is the variable used to determine the blank row
on the working sheet
Dim BegAddress 'used to deliver beginning cell address to range functions
Dim EndAddress 'used to deliver end cell address to range functions
Dim stType As String 'Used to control the Do-While loop
Dim stBlank As String ' Used to control the do-while loop that determines
blank rows
'Select first row of the Master worksheet
Worksheets("Engineer Roles Table").Select
inMasterRow = 2
stType = Cells(inMasterRow, 1).Value 'Used to initiate the Do-While loop
Do While stType <> ""
Worksheets("Engineer Roles Table").Select
stRole = Cells(inMasterRow, 5).Value
stType = Cells(inMasterRow, 1).Value
BegAddress = Cells(inMasterRow, 1).Address
EndAddress = Cells(inMasterRow, 9).Address
'Copy data (Select row)
Range(BegAddress & ":" & EndAddress).Copy
'Determine which sheet to paste data according to ESM Status (Select Case)
'Select proper worksheet according to status
'MsgBox ESMStatus 'for auditing
If stRole <> "" Then
Worksheets(stRole).Select
'Find first empty row on the selected sheet
inRow = 1
stBlank = Cells(inRow, 1).Value
Do While stBlank <> ""
inRow = inRow + 1
stBlank = Cells(inRow, 1).Value
Loop
End If
'Paste Data
BegAddress = Cells(inRow, 1).Address
EndAddress = Cells(inRow, 9).Address
Range(BegAddress & ":" & EndAddress).PasteSpecial
'Go to the next row (repeat the ESMStatus Do-While loop until finished)
inMasterRow = inMasterRow + 1
Loop
Application.ScreenUpdating = True
End Sub