non-working InsertPrismaID

Sub CompleteTrafficImport()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'setting up strings and lookups
Dim strPath As String
Dim FileName As String
Dim SelectedFiles As String
Dim TWorkBK As Workbook
Set TWorkBK = ThisWorkbook
Dim TPrismaWBK As Worksheet
Set TPrismaWBK = TWorkBK.ActiveSheet
Dim DCMTagSheet As String
DCMTagSheet = ""
'opening the document
strPath = "S:\SMGSHARE\Depts\IP_Shared\Starcom_TAAG\Documentation\The Unicorn Traffic Sheet\PrimsaPull"
SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=False)
FileName = Dir(strPath & "*.csv*")
FileName = SelectedFiles
Dim PWorkBk As Workbook
Dim TSheet As Worksheet

Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Set PWorkBk = Workbooks.Open(FileName)
'Delete first five rows of Primsa Pull
    Rows("1:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
'Rename sheet
    ActiveSheet.Name = "PrismaPull"

'Name all da columns
Dim sheetcol As Range

Columns(1).Select

For Each sheetcol In ActiveSheet.Columns
    If Trim(Cells(1, sheetcol.Column)) <> "" Then
        iCol = sheetcol.Column
        iAlpha = Int(iCol / 27)
        iRemainder = iCol - (iAlpha * 26)
        If iAlpha > 0 Then
           colletter = Chr(iAlpha + 64)
        End If
        If iRemainder > 0 Then
           colletter = ConvertToLetter & Chr(iRemainder + 64)
        End If
        Columns(sheetcol.Column).Select
        namecheck = Replace(Cells(1, sheetcol.Column), " ", "")
        namecheck = Replace(namecheck, "-", "")
        namecheck = Replace(namecheck, "(", "")
        namecheck = Replace(namecheck, ")", "")
        namecheck = Replace(namecheck, "%", "")
        namecheck = Replace(namecheck, "/", "")
        namecheck = Replace(namecheck, "+", "")
        namecheck = Replace(namecheck, ":", "")
        namecheck = Replace(namecheck, "=", "")
        namecheck = Replace(namecheck, "&", "")
        namecheck = Replace(namecheck, "'", "")
        namecheck = Replace(namecheck, ">", "")
        realsheetname = ActiveSheet.Name
        fakesheetname = Replace(ActiveSheet.Name, " ", "")
        fakesheetname = Replace(fakesheetname, "(", "")
        fakesheetname = Replace(fakesheetname, ")", "")
        fakesheetname = Replace(fakesheetname, "&", "")
        fakesheetname = Replace(fakesheetname, "-", "")
        fakesheetname = Replace(fakesheetname, "'", "")
        fakesheetname = Replace(fakesheetname, "/", "")
        fakesheetname = Replace(fakesheetname, "+", "")
        fakesheetname = Replace(fakesheetname, ":", "")
        fakesheetname = Replace(fakesheetname, "=", "")
        fakesheetname = Replace(fakesheetname, ">", "")
        nameaddress = "='" & realsheetname & "'!$" & colletter & ":$" & colletter
        ActiveWorkbook.Names.Add Name:=fakesheetname & namecheck, RefersToLocal:=nameaddress
    Else
        Exit For
    End If
Next

' DeleteBlankPlacements Macro
   
    Application.Goto "PrismaPullPlacementname"
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 'Select Named Range and Copy Placements
    Dim c As Long

    c = PWorkBk.Worksheets("PrismaPull").Range("PrismaPullPlacementId").Column
    PWorkBk.Worksheets("PrismaPull").Range( _
                    PWorkBk.Worksheets("PrismaPull").Cells(1, c), _
                    PWorkBk.Worksheets("PrismaPull").Cells( _
                    PWorkBk.Worksheets("PrismaPull").Rows.Count, c).End(xlUp)).Copy
   'Select where to paste Placement names
Dim PlacementRange As Range
Set PlacementsRange = PWorkBk.Worksheets("PrismaPull").Range("U:V")
Columns("V:V").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("V:V").PasteSpecial xlPasteValues
Range("V1").Value = ("New Prisma ID")






Windows(TWorkBK.Name).Activate
Sheets(TPrismaWBK.Name).Activate

Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H11").Value = "Prisma ID"

Dim D_PrismaID As Range

With TPrismaWBK
'Dim I_PlacementName As Range
'Set I_PlacementName = PWorkBk.Worksheets("PrismaPull").Range("U1:V")
Dim D_PlacementName As Range
Set D_PlacementName = TPrismaWBK.Range("J12:J" & LastRow)

LastRow = .Range("G" & .Rows.Count).End(xlUp).Row
Set D_PrismaID = TPrismaWBK.Range("H12:H" & LastRow)
D_PrismaID.Value = Application.WorksheetFunction.VLookup(D_PlacementName, PlacementsRange, 2, 0)

End With
End Sub