VBA to search for table from PDF File and copy and paste to Worksheet

[cboyce44]

I have a work sheet that I have the operator click on a button, and it lets them select a pdf file. I have it so the pdf file converts to an excel table:

Private Sub CommandButton2_Click()

Dim userSelectedFile As Variant
Dim windowTitle As String
Dim fileFilter As String
Dim fileFilterIndex As Integer
Dim OpenBook As Workbook
Application.ScreenUpdating = False
windowTitle = "Choose your Gage Block Cert pdf file"

fileFilter = "PDF Files (*.pdf),*.pdf" 'Allows user to select pdf files only
'fileFilter = "PDF or Text Files (*.pdf;*.txt),*.pdf;*.txt" 'Allows user to select pdf or text files

fileFilterIndex = 1 ' For fileFilter to allow user to select pdf files only
'fileFilterIndex = 2 ' For fileFilter to allow user to select pdf or text files

userSelectedFile = Application.GetOpenFilename(fileFilter, fileFilterIndex, windowTitle)

If userSelectedFile = False Then
MsgBox "No File selected."
Exit Sub
Else
MsgBox "File selected: " & userSelectedFile
ThisWorkbook.FollowHyperlink (userSelectedFile)
End If

'Sends Commands in Adobe to create data from pdf file
Application.SendKeys "%{f}", True
Application.SendKeys "t", True
Application.SendKeys "s", True
Application.SendKeys "e", True
Application.SendKeys userSelectedFile, True
Application.SendKeys "^{ENTER}", True
Application.SendKeys "y", True
Application.SendKeys "{numlock}%s", True
Application.Wait Now + 0.0001

Now I want it to search for the table "Test Points" shown below, in the opened Workbook Table that the PDF created

I need just the numbers from under "Nominal Size", and "Final" to be copied and pasted to another worksheet labeled "GageBlockData" A1.

Can someone please help me with this?

 

[Alex Blakenburg]

I think this is better handled here but for context

Finding a value, then copying and pasting cells around it to another sheet

Hello. I am a novice with Excel VBA. I have a certificate excel workbook that contains 34 sheets. So far I have it where the user imports data from a PDF document into a sheet called "PitchGageData". What I'm trying to do is search in the "PitchGageData" tab to look for "L1". Once it...

www.mrexcel.com

Okay. So from your original search in this thread what is going on with the rest of this?

Set rngSrc = rngSrc.Offset(0)
Set rngSrc = rngSrc.Resize(24, 6)
cntItem = WorksheetFunction.CountA(rngSrc)

ReDim arrDest(1 To 3, 1 To cntItem)

For Each rCell In rngSrc
If rCell <> "" Then
i = i + 1
If Left(rCell, 1) = "" Then
arrDest(1, i) = "" & i
Else
arrDest(1, i) = rCell.Value
End If
arrDest(2, i) = Replace(rCell.Offset(1).Value, "I", 1)
arrDest(3, i) = Replace(rCell.Offset(2).Value, "I", 1)

End If
Next rCell

rngDest.Resize(3, i).Value = Application.Substitute(arrDest, "l", 1)

I'm trying to learn this, and am confused. When I run this, I get all of the data, but it looks like this:

It stretches all of the data out to column BT an duplicates a lot of the data.

 

[Alex Blakenburg]

I think that this is sufficiently different to your other thread so that you can't use the same approach.

You are indicating you don't want the headings which surprises me a little but try this to start with.

Sub FindAndCopy_NominalSize()

    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim rngSrc As Range, rngDest As Range, rCell As Range
    Dim rowSrc As Long
    Dim colLast As Long
    Dim cntItem As Long
    Dim arrDest As Variant
    Dim i As Long
    
    Set wsSrc = ActiveSheet                     ' If you know the sheet name use - Worksheets("Sheet_Name")
    Set wsDest = Worksheets("GageBlockData")
    Set rngDest = wsDest.Range("A1")
    
    ' Look for Nominal Size
    Set rngSrc = wsSrc.UsedRange.Find(What:="Nominal Size", LookIn:=xlFormulas, LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                        MatchCase:=False, SearchFormat:=False)
                                        
    If rngSrc Is Nothing Then Exit Sub
    
    ' Data range is a fixed size
    rngDest.Offset(1).Resize(24).Value = rngSrc.Offset(1).Resize(24).Value
    rngDest.Offset(1, 1).Resize(24).Value = rngSrc.Offset(1, 5).Resize(24).Value
              
End Sub

 

[cboyce44]

I don't mind having the headings. I just need the data below it. That worked! Thanks!

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.

 

[cboyce44]

Alex,

I have an issue. My company moved to Windows 11, and Excel changed a few things to the point where this code no longer works. I'm wondering if you can help me out. It's getting stuck when it opens up the user selected pdf file (See bold in code below). I currently have it where the pdf document opens, then I send the keys to basically open up under Main Menu "File", then select "Export a Pdf", then select Microsoft Excel, finally select "Microsoft Excel Workbook". When this happened the newly opened Workbook used to have the extension "(userSelectedFile.pdf).xlsx" after it. Now the current way Excel opens a new Workbook using the method I have, it just has the "(userSelectedFile).xlsx". It is missing the .pdf. I don't know how to make it so when the User selects the .pdf file, the program can see the newly opened Workbook with just the Name of the file they selected and the .xlsx after it? I tried using "*.xlsx" but it errors out. I'm hoping you can help me out. Here is the current code I'm trying to use. If you know of a MUCH easier way to import PDF file, then please let me know. I'm a beginner at all of this, and have just self taught myself what little I know.

Private Sub CommandButton2_Click()

Dim userSelectedFile As Variant
Dim windowTitle As String
Dim fileFilter As String
Dim fileFilterIndex As Integer
Dim OpenBook As Workbook
Application.ScreenUpdating = False
windowTitle = "Choose your Gage Block Cert pdf file"

fileFilter = "PDF Files (*.pdf),*.pdf" 'Allows user to select pdf files only
'fileFilter = "PDF or Text Files (*.pdf;*.txt),*.pdf;*.txt" 'Allows user to select pdf or text files

fileFilterIndex = 1 ' For fileFilter to allow user to select pdf files only
'fileFilterIndex = 2 ' For fileFilter to allow user to select pdf or text files

userSelectedFile = Application.GetOpenFilename(fileFilter, fileFilterIndex, windowTitle)

If userSelectedFile = False Then
MsgBox "No File selected."
Exit Sub
Else
MsgBox "File selected: " & userSelectedFile
ThisWorkbook.FollowHyperlink (userSelectedFile)
End If

'Sends Commands in Adobe to create data from pdf file
Application.SendKeys "%{f}", True
Application.SendKeys "d", True
Application.SendKeys "x", True
Application.SendKeys "e", True
Application.SendKeys userSelectedFile, True
Application.SendKeys "^{ENTER}", True
Application.SendKeys "y", True
Application.Wait Now + 0.00005
Application.SendKeys "{numlock}%s", True
Application.Wait Now + 0.0001

'Opens Workbook that is created. Copies and pastes data into GageBlockData tab
Set OpenBook = Application.Workbooks.Open(userSelectedFile & ".xlsx")
OpenBook.Sheets(1).Range("A1:P100").Copy

ThisWorkbook.Worksheets("GageBlockData").Range("A1").PasteSpecial xlPasteValues


Dim wsSrc As Worksheet, wsDest As Worksheet
Dim rngSrc As Range, rngDest As Range, rCell As Range
Dim rowSrc As Long
Dim colLast As Long
Dim cntItem As Long
Dim arrDest As Variant
Dim i As Long

Set wsSrc = GageBSh ' If you know the sheet name use - Worksheets("Sheet_Name")
Set wsDest = ThisWorkbook.Worksheets("Nominal Error Calculations")
Set rngDest = wsDest.Range("A67")

' Look for Nominal Size
Set rngSrc = wsSrc.UsedRange.Find(What:="Nominal Size", LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If rngSrc Is Nothing Then Exit Sub

' Data range is a fixed size
rngDest.Offset(0).Resize(25).Value = rngSrc.Offset(0).Resize(25).Value
rngDest.Offset(0, 1).Resize(25).Value = rngSrc.Offset(0, 9).Resize(25).Value


Set pApp = CreateObject("AcroExch.App")
pApp.GetActiveDoc.Close True
Set pApp = Nothing

CutCopyMode = False

Application.CutCopyMode = False

Application.ScreenUpdating = True




End Sub