I hope you are well I have some code see below. Essentially what it does is allows a user to upload two workbooks and it performs a Vlookup. The Macro was working fine until the sheets went from 65,000 to 280,000 rows. I first got the error 'run time 6 overflow' so I changed
Dim intLastRow As Integer
to
Dim intLastRow As Double
That is when I got the Run Time error 13 on this line of code
.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
I know diming intLastRow As Double
has created a mismatch but do i dim intLastRow As Double
as something else or do i amend the code else where? Any help would be greatly appreciated. the rest of my code is below.
Sub Add_consent()
'Definition of used variables
Dim Directory As String 'Directory for inputs and outputs
Dim Consent_folder As String 'Directory for inputs and outputs
Dim inputFile As String 'Input file name
Dim currentInput As String 'Input file name
Const DELIMITER As String = "|" 'Values delimiter
Dim OutputFile As String 'Output file name
Dim lngCount As Long 'selected files count
Dim wbkOutput As Workbook 'output workbook
Dim wbkTemp As Workbook 'temporary workbook
Dim myWkBook As Workbook 'Input Workbook
Dim Consent As Workbook 'Consent file
Dim Consent_name 'new opened file
Dim myWkSheet As Worksheet 'Input Worksheet
Dim sheetNum As Long 'Variable for sheet number
Dim sheetNames() As String 'output worksheet sheet names
Dim sheetInterfaceName 'Sheet name representing DID interface
Dim Active As Worksheet 'Active worksheet
Dim intLastRow As Double 'Last Row Element
Dim Error_Codes As Worksheet ' Sheet containing error codes
Dim myRecord As Range 'Record for output
Dim myField As Range 'Cell value for output
Dim nFileNum As Long 'Variable for file number
Dim sOut As String 'Text to be written into file
Dim invalidDelete As String 'Case of invalid delete attempt
Dim sheetIndex As Long ' Current sheet index
Dim Selected As Long '
Dim rwCount As Long 'Number of current sheet rows containing data in tracking file
Dim colCount As Integer 'Number of current sheet columns containing data in tracking file
Dim extraCol As Integer 'Number of current sheet columns containing data in tracking file
Dim indexRow As Long 'Row index
Dim helpRow As Long '
Dim AddIn As Integer
Dim selectedCount As Integer
Dim int1 As Long
Dim int2 As Integer
Dim int3 As Integer
'General application settings
Application.ScreenUpdating = False 'Turns off switching to exported excel file once it gets opened
Application.DisplayAlerts = False 'Turns off automatic alert messages
Application.EnableEvents = False '
Application.AskToUpdateLinks = False 'Turns off the "update links" prompt
'User prompt, choose HCP file
MsgBox "Choose HCP/HCO file missing consent information"
'Alternative way to open the file
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
'Assign a number for the selected file
Dim FileChosen As Integer
FileChosen = fd.Show
If FileChosen <> -1 Then
'Didn't choose anything (clicked on CANCEL)
MsgBox "No file selected - aborted"
End 'Ends file fetch and whole sub
End If
Dim fss As Object
Set fss = CreateObject("Scripting.FilesystemObject")
inputFile = Dir(fd.SelectedItems(1)) 'parses only the name of file
Directory = fss.getParentFolderName(fd.SelectedItems(1)) & "\" 'parses only directory of the file
'Open HCP file .xlsx spreadsheet
Set wbkTemp = Workbooks.Open(Filename:=Directory & inputFile)
'Set wbkTemp = Workbooks(Workbooks.Count)
'Get number of columns in the HCP file
colCount = wbkTemp.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
'Get the number of rows in the HCP file
intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'Set GCM_ID format to number
wbkTemp.Sheets(1).Range(wbkTemp.Sheets(1).Cells(2, 1), wbkTemp.Sheets(1).Cells(intLastRow, 1)).Select 'Specify the range which suits your purpose
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
'Prompt user for the second file
MsgBox "Select file(s) containing Consent information"
'Open Consent file dialog
Dim filedial As FileDialog
Set filedial = Application.FileDialog(msoFileDialogOpen)
Dim chosen As Integer
chosen = filedial.Show
If chosen <> -1 Then
'Didn't choose anything (clicked on CANCEL)
MsgBox "No file selected - aborted"
End 'Ends file fetch and whole sub
End If
'Number of selected files
selectedCount = filedial.SelectedItems.Count
'Extra variable
AddIn = 0
For Selected = 1 To selectedCount
'Open file with Consent info
Consent_name = Dir(filedial.SelectedItems(Selected))
'Consent_folder
Workbooks.OpenText Filename:=Consent_name, StartRow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"
Set Consent = Workbooks(Workbooks.Count)
'Number of rows in consent file
rwCount = Consent.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'Specify the column to paste data
extraCol = colCount + AddIn + 1
'1)
'VLOOKUP across spreadsheets for consent data
'wbkTemp.Sheets(1).Cells(1, 1).Copy
'wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats
'wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent"
'With wbkTemp.Sheets(1)
'.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
'End With
'2)
'VLOOKUP across spreadsheets for consent data
'wbkTemp.Sheets(1).Cells(1, 1).Copy
'wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats
'wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent"
'With wbkTemp.Sheets(1)
' '.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
' For int1 = 2 To intLastRow
' if Application.WorksheetFunction.IsNA(Application.WorksheetFunction.VLookup(.Cells()))
'
' Next int1
'End With
'3)
'VLOOKUP across spreadsheets for consent data
wbkTemp.Sheets(1).Cells(1, 1).Copy
wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats
wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent"
With wbkTemp.Sheets(1)
.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
End With
'Close the file with consent information
Consent.Close
'Loop again for next file
AddIn = AddIn + 1
Next Selected
'Deal with N/A values
With wbkTemp.Sheets(1)
For int1 = 2 To intLastRow
For int2 = 1 To selectedCount
If Not Application.WorksheetFunction.IsNA(.Cells(int1, colCount + int2).Value) Then
.Cells(int1, colCount + 1).Value = .Cells(int1, colCount + int2).Value
End If
Next int2
Next int1
End With
'Remove extra columns
With wbkTemp.Sheets(1)
.Columns(fnColumnToLetter_Split(colCount + 2) & ":" & fnColumnToLetter_Split(extraCol + selectedCount)).Delete Shift:=xlToLeft
End With
'Save and close the new workbook
With wbkTemp
'Save and close the new workbook
.SaveAs Filename:=inputFile
.Close True
End With
MsgBox "Available consent information added"
End Sub
Function fnColumnToLetter_Split(ByVal intColumnNumber As Integer)
fnColumnToLetter_Split = Split(Cells(1, intColumnNumber).Address, "$")(1)
End Function
There seems to be an issue with passing more than 65536 Values as the first parameter in the VLookup function.
So this line of code will fail:
Range("L2:L80000").Value = Application.WorksheetFunction.VLookup(Range("A2:A80000").Value, Range("B:J"), 8, False)
But passing just a Range (and allowing VLookup to access the default Value property) is OK, so the following line of code will work:
Range("L2:L80000").Value = Application.WorksheetFunction.VLookup(Range("A2:A80000"), Range("B:J"), 8, False)
So, if you change your line to
.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)), Consent.Sheets(1).Range("B:J"), 8, False)
it should be OK.
PS As Philip Connell suggested, change the definition of intLastRow to be Long. Being Double may not be the cause of this specific problem, but leaving it as Double will potentially cause you all sorts of other issues.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.