First thanks for any help up front!
I wrote the below macro in Excel (2010) VBA to add markers to contracts with various issues to a master tracker. While doing some size testing I am getting error 400 when I attempt to run with an input of 50,000 contracts (array Contracts), but it runs fine with 40,000 (took about 14 minutes). Any ideas at why I am getting the error? Commented in the code where it is stopping at 50,000. Thank you!
Sub UploadNew()
''''''''''''''''''''''''Add All Contracts to End of Master'''''''''''''''''''''''''''''''
'Set up the array Contracts which will house the new contracts to be uploaded
Dim Contracts() As String
Dim size As Long
Dim R As Integer
Dim N As Long
'This sets up the value for N as the end of the current master list
N = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
'Determine size of array and store it into variable size
size = Worksheets("Update").Cells(Rows.Count, "A").End(xlUp).Row - 1
'Identifies which Remediation column to add the marker to
R = Application.WorksheetFunction.VLookup(Worksheets("Update").Range("F2"), Range("E14:G263"), 3, False)
'Having counted size we can redimension the array
ReDim Contracts(size)
'Insert the values in column A into the array
Dim i As Long
For i = 1 To size
Contracts(i) = Range("A1").Offset(i)
Next i
'Takes each value in the array and adds it to the end of the master list using N
For i = 1 To size
Worksheets("Master").Range("A" & N).Value = Contracts(i)
N = N + 1
Next i
'Remove the duplicates from the master tab based on the first column
Worksheets("Master").Range("A:ZZ").RemoveDuplicates Columns:=Array(1)
'Remove blank rows from Master
Dim rng As Range
Set rng = Worksheets("Master").Range("A2:A" & N).SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Delete
''''''''''''''''''''''''Add All Contracts to End of Master'''''''''''''''''''''''''''''''
'''''''''''''''''''''Place New Contract Marker for Each Contract'''''''''''''''''''''''''
'This searches all the contracts in the master and places a 1 R columns to the right of
'the found contract
For i = 1 To size
Dim rgFound As Range
Set rgFound = Worksheets("Master").Range("A2:A" & N).Find(Contracts(i))
'! Code is stopping about here with 50,000 contracts, doesn't add a single marker !'
With rgFound.Offset(, R)
.Value = "1"
.NumberFormat = "General"
End With
Next i
'''''''''''''''''''''Place New Contract Marker for Each Contract'''''''''''''''''''''''''
End Sub
Aucun commentaire:
Enregistrer un commentaire