Conell8383
Board Regular
- Joined
- Jul 26, 2016
- Messages
- 66
I hope you are all well. I have the below macro which works like a charm 
, but it only works if Customer ID is in column A. of the first sheet. (see pic) The issue I now face is that Customer ID is now in Column D and will remain there.
Can anyone help and amend my code so that it will work with Customer ID in Column D not A. The code is below and i have also attached pis of the sheets for better understanding. THANK YOU for the help.
So what is happening is that the information on the 2nd pic excel sheet in column I "yes or no" is being brought into the first sheet with a Vlookup using the customer ID as the identifier. Works great if Customer Id is in the first column of the first pic Excel sheet but wont work if the Customer ID is in Column D
Code Below
I have added a pic of what the sheet where the info is pasted into
The Sheet where the information is brought from looks like
, but it only works if Customer ID is in column A. of the first sheet. (see pic) The issue I now face is that Customer ID is now in Column D and will remain there.Can anyone help and amend my code so that it will work with Customer ID in Column D not A. The code is below and i have also attached pis of the sheets for better understanding. THANK YOU for the help.
So what is happening is that the information on the 2nd pic excel sheet in column I "yes or no" is being brought into the first sheet with a Vlookup using the customer ID as the identifier. Works great if Customer Id is in the first column of the first pic Excel sheet but wont work if the Customer ID is in Column D
Code Below
Code:
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 Long '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 TOV 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)), 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 FunctionI have added a pic of what the sheet where the info is pasted into
The Sheet where the information is brought from looks like
Last edited:
