Looking for VBA to help with data collection

[ExcelNewbie2009]

Provide for the coders:

1. Version of the program
   1. Microsoft 365 MSO (Version 2204 Build 16.0.15128.20278) 64-bit
2. What you want it to do
   1. I would like to derive data from the files within a folder, and perform the writing functions within excel, as I have listed below in my screenshot:
   2. 
3. I have VBA code that does parts of what I need, but since I added more columns and renamed columns, all the links are pretty much broken (attaching the code for your review).

I have very limited knowledge when it comes to writing VBA, so any and all help would be greatly appreciated, even if code needs to be re-written.

Option Explicit
    Public xFSO, xFolder, t3 As Object
    Public xFile, xFileF, xSubFolder As Object
    Public myFolderName, toAddress, toJob, ProjectNum, Notes, toAttn, code As String
  
Sub TransmittalsIn()
    ActiveSheet.Shapes("Arrow-OUT").Visible = False
    ActiveSheet.Shapes("Arrow-IN").Visible = False
    ActiveSheet.Shapes("Cross1").Visible = True
      
    Dim xFiDialog As FileDialog
    Dim i, r, DeleteRows, SIC As Integer
    Dim Tran, xPath, countfile, ypath As String
  
On Error GoTo GameOver
Application.ScreenUpdating = False
  
    Worksheets("LOG").Activate
  
'        REV = InputBox(Prompt:="Enter Rev #", Title:="Rev #", Default:="0")
'           If REV = vbNullString Then Exit Sub
          
        code = InputBox(Prompt:="Enter Transmittal Code.", Title:="Transmittal Code", Default:="Approved")
            If code = vbNullString Then Exit Sub
          
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
      
        With xFiDialog
            .InitialFileName = ThisWorkbook.Path & "\IN"
            .AllowMultiSelect = False
                If .Show = -1 Then xPath = xFiDialog.SelectedItems(1)
        End With
      
    Set xFiDialog = Nothing
      
        If xPath = "" Then Exit Sub
            Set xFSO = CreateObject("Scripting.FileSystemObject")
            Set xFolder = xFSO.GetFolder(xPath)
       
' Count the number of files
        ypath = xPath & "\*.*"
        countfile = Dir(ypath)
        Do While countfile <> ""
            SIC = SIC + 1
            countfile = Dir()
        Loop
i = 0
MsgBox "File Count = " & SIC, vbOKOnly

        Range("A5").End(xlDown).Select
            If ActiveCell().Value <> "" Then
                    Worksheets("LOG").ListObjects("Trans").ListRows.ADD               ' Adds a new row to the table
                    ActiveCell().Offset(1).Select
                Else
                    ActiveCell.Offset(-1).Select
            End If
      
    For Each xFile In xFolder.Files
            i = i + 1
            ActiveSheet.Hyperlinks.ADD ActiveCell(i, 1), xFolder.Path, TextToDisplay:=xFolder.Name 'A - Transmittal # -- ' Hyperlink to folder, uses folder name as display text -options: xFile.Path, xFile.Name
                        'trimmer xFolder.Path
            ActiveCell(i, 2).Formula = "=IF([@[Transmittal Code]]<>""A"",LOOKUP(2,1/([Team File Name]&[Revision '#]&[Transmittal Code]=[@[Team File Name]]&[@[Revision '#]]&""A""),"""")"
            ActiveCell(i, 3) = xFile.Name  'C - Team File Name                                              ' returns filename and extension -- xFile.BaseName - returns just the filename
            ActiveCell(i, 4) = UCase(code) 'D - Transmittal Code                                            ' Transmittal Code
            ActiveCell(i, 5).Formula = "=IF([@[Transmittal Code]]<>""A"",LOOKUP(2,1/([Team File Name]&[Transmittal Code]=[@[Team File Name]]&""A""),([Revision '#])),"""")"         'E - Revision #                                                  ' Document Rev #
            ActiveCell(i, 6).Formula = "=IF([@[Transmittal Code]]="""","""",LOOKUP(2,1/([Team File Name]&[Revision '#]=[@[Team File Name]]&[@[Revision '#]]),([Transmittal Code])))" 'F - Status
            ActiveCell(i, 7).Formula = "=IF([@[Transmittal Code]]<>""A"",LOOKUP(2,1/([Team File Name]&[Revision '#]&[Transmittal Code]=[@[Team File Name]]&[@[Revision '#]]&""A""),([Submittal Date])),"""")"
            ActiveCell(i, 8) = Date     'H - Response Date                                               ' Response Date - prevents autofill from table
            If i < SIC Then
                Worksheets("LOG").ListObjects("Trans").ListRows.ADD                                      ' Adds a new row to the table
            End If
    Next xFile
    i = 0 ' resets i back to 0
Application.ScreenUpdating = True
GameOver:
End Sub
  
Sub TransmittalsOut()
  
    Dim xFiDialog As FileDialog
    Dim i, r, DeleteRows, SIC As Integer
    Dim REV, Tran, xPath, countfile, ypath As String
  
ActiveSheet.Shapes("Arrow-OUT").Visible = False
ActiveSheet.Shapes("Arrow-IN").Visible = False
ActiveSheet.Shapes("Cross1").Visible = True
      
  
On Error GoTo GameOver
Application.ScreenUpdating = False
  
    Set t3 = Worksheets("Transmittal").ListObjects("Trans3")
    Worksheets("LOG").Activate
  
        REV = InputBox(Prompt:="Enter Rev #", Title:="Rev #", Default:="0")
            If REV = vbNullString Then Exit Sub
          
        code = InputBox(Prompt:="Enter Transmittal Code.", Title:="Transmittal Code", Default:="C")
            If code = vbNullString Then Exit Sub
          
        DeleteRows = MsgBox("Adding to the Transmittal?", vbQuestion + vbYesNo)
          
        toJob = Worksheets("LOG").Range("B1").Value                 ' Gets Job Number
        ProjectNum = Worksheets("LOG").Range("D1").Value            ' Gets Project Number
        Notes = Worksheets("LOG").Range("D3").Value                 ' Gets Project Name
        toAddress = Worksheets("LOG").Range("F2").Value             ' Gets the address of E-mail, FTP, Web Portal, etc...
        toAttn = Worksheets("LOG").Range("F1").Value                ' Gets AttnTo
  
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
      
        With xFiDialog
            .InitialFileName = ThisWorkbook.Path
            .AllowMultiSelect = False
                If .Show = -1 Then xPath = xFiDialog.SelectedItems(1)
        End With
      
    Set xFiDialog = Nothing
      
        If xPath = "" Then Exit Sub
            Set xFSO = CreateObject("Scripting.FileSystemObject")
            Set xFolder = xFSO.GetFolder(xPath)
       
' Count the number of files
        ypath = xPath & "\*.*"
        countfile = Dir(ypath)
        Do While countfile <> ""
            SIC = SIC + 1
            countfile = Dir()
        Loop

MsgBox "File Count = " & SIC, vbOKOnly


        Range("A5").End(xlDown).Select
            If ActiveCell().Value <> "" Then
                    Worksheets("LOG").ListObjects("Trans").ListRows.ADD               ' Adds a new row to the table
                    ActiveCell().Offset(1).Select
                Else
                    ActiveCell.Offset(-1).Select
            End If
      
    For Each xFile In xFolder.Files
            i = i + 1
            ActiveSheet.Hyperlinks.ADD ActiveCell(i, 1), xFolder.Path, TextToDisplay:=xFolder.Name 'A - Transmittal # -- ' Hyperlink to folder, uses folder name as display text -options: xFile.Path, xFile.Name
                        'trimmer xFolder.Path
                        'ActiveCell(i, 3) = myFolderName 'xFolder.Path ' Folder Path (would like to shorten to \folder\folder\
            ActiveCell(i, 3) = xFile.Name  'C - File Name                                              ' returns filename and extension -- xFile.BaseName - returns just the filename
            ActiveCell(i, 4) = UCase(code) 'D - Transmittal Code                                            ' Transmittal Code
            ActiveCell(i, 5) = REV         'E - Revision #                                                  ' Document Rev #
            ActiveCell(i, 6).Formula = "=IF([@[Transmittal Code]]="""","""",LOOKUP(2,1/([File Name]=[@[File Name]]),([Transmittal Code])))" 'F - Status
            ActiveCell(i, 7) = Date        'G - Submittal Date                                              ' Current date
            'ActiveCell(i, 8) = ""          'H - Document Type                                               ' Document Type - prevents autofill from table
            If i < SIC Then
                Worksheets("LOG").ListObjects("Trans").ListRows.ADD                                             ' Adds a new row to the table
            End If
    Next xFile
        i = 0 ' resets i back to 0
Worksheets("Transmittal").PageSetup.CenterHeader = "&C&B" & toJob & "- Transmittal - " & xFolder.Name & vbLf & ProjectNum & vbLf & Notes


  
        Worksheets("Transmittal").Activate
        
            If DeleteRows = vbNo Then
                With t3
                    If .ListRows.Count >= 1 Then .DataBodyRange.Delete
                End With
                Range("B9").Select
                Else
                Range("B9").End(xlDown).Select
                    If Left(Trim(ActiveCell().Formula), 1) = "=" Then ActiveCell.Offset(-1).Select Else
                    If ActiveCell().Value <> "" Then
                        Worksheets("Transmittal").ListObjects("Trans3").ListRows.ADD           ' Adds a new row to the table
                        ActiveCell.Offset(1).Select
                    End If
            End If
              
        For Each xFile In xFolder.Files
                i = i + 1
                ActiveCell(i, 1) = xFile.Name                                                   ' Returns filename
                ActiveCell(i, 2) = REV                                                              ' Rev #
                'ActiveCell(i, 3) = -Currently Blank-                                               ' Blank
                ActiveCell(i, 4) = UCase(code)                                                      ' Transmittal Code
                    If UCase(code) = "C" Then
                            ActiveCell(i, 5) = "Shipment " & xFolder.Name & " Spool QA Data Package" ' Comments   xsubfolder.name
                        Else
                            ActiveCell(i, 5) = ""
                    End If
            If i < SIC Then
                Worksheets("Transmittal").ListObjects("Trans3").ListRows.ADD                     ' Adds New Row
            End If
         Next xFile
      
        Cells.Select
        Cells.EntireColumn.AutoFit
        Cells.EntireRow.AutoFit
        Range("B7").Select
     
    Worksheets("LOG").Activate
        Cells.Select
        Cells.EntireColumn.AutoFit
        Cells.EntireRow.AutoFit
        Range("A5").Select
    If Worksheets("Log").CheckBox1.Value = True Then
        ActiveWorkbook.FollowHyperlink Range("b4").Value
    End If
        SIC = 0
      
Application.ScreenUpdating = True
GameOver:
End Sub


Private Sub savefile()
   Dim SavePrompt As Integer
  
    SavePrompt = MsgBox("Save as PDF?", vbQuestion + vbYesNo)
        If SavePrompt = vbYes Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
        Else
            Exit Sub
        End If
End Sub

Private Sub trimmer(FolderPath)
    Dim U As Variant

    On Error GoTo GameOver

'        x = xFolder.Path
        For U = Len(FolderPath) To 1 Step -1
            If Mid(FolderPath, U, 4) = "QCS)" Then GoTo SkipOut
            If Mid(FolderPath, U, 4) = "Q-QA" Then GoTo NextSkipOut
        Next U
SkipOut:
    myFolderName = Right(FolderPath, Len(FolderPath) - U - 20)
NextSkipOut:
    myFolderName = Right(FolderPath, Len(FolderPath) - U - 17)
  

GameOver:
End Sub

Sub SendEmail()
    Dim OutApp, OutMail As Object
    Dim AddressTo, PM, CcTo, Job, Client, Project, ProjectNumber, Greeting As String
  
  
If Time() < TimeValue("11:59:59 AM") Then Greeting = "Good morning,"
If Time() > TimeValue("12:00:00 PM") Then Greeting = "Good afternoon,"
If Time() > TimeValue("05:00:00 PM") Then Greeting = "Good evening,"
 
        AddressTo = Worksheets("LOG").Range("F2").Value     ' Contact Emails
        CcTo = Worksheets("LOG").Range("F3").Value          ' Contact Cc Emails
        PM = Worksheets("LOG").Range("B2").Value            ' Project Manager
        Job = Worksheets("LOG").Range("B1").Value           ' Project Name
        Client = Worksheets("LOG").Range("D2").Value        ' Client Name
        Project = Worksheets("LOG").Range("D3").Value       ' Project Name
        ProjectNumber = Worksheets("LOG").Range("D1").Value ' Project Number
      
  
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .to = AddressTo
            .Cc = CcTo & ";" & PM & ";" & "Dean Renard"
            .Subject = Job & "-" & xFolder.Name & " " & Client & " " & ProjectNumber & " " & Project & "-{DESCRIPTION}"
            .HTMLBody = Greeting
            '.Attachments.Add 'File to add
            .Display
        End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Thank you!!!