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

[cboyce44]

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 finds which cell it is in (depending on the pdf file, it moves around), I then want to copy that cell. I need the "L1", then the 2 values below it. Then I need the same for "L2", "L3", "L4", "L5", and "L6". Below is a screen shot of how the pdf was imported into the sheet.

Once I have copied all the values in the cells, I want to paste them to another worksheet called "Nominal Error Calculations" into cell A60, and look like this:

Thank you for your help. I have spent days trying to figure this out.

 

[cboyce44]

That is image is very different to the one in Post #1.
In post #1 I would have looked for something like "mutual difference of diameter".
Also the latest post looks like it has merged cells.

1) Have you tried reading it in using Power Query (Data > From File > From PDF) it may give you a cleaner result
2) If that is not an option we need a representative sample of how the pdf looks once you get it into Excel.
Either copying it here using XL2BB or putting a sample on a share service like google drive, drop box etc.

Alex, I apologize. That last example is from the Workbook that is created in my program when it takes the pdf file, and converts it to a worksheet. I know about Power Query, but don't know how to link it in a program. I can't use XL2BB on my work laptop. However, I can send you a couple of PDF's of the Certs I have that I'm trying to import, and you can look at them? I would just need your email address.

 

[Alex Blakenburg]

I'm afraid that is not allowed under the forum rules.
If you can share it via dropbox, google drive etc we can take a look.

You mention not being able to hook up PQ to a program but how are you loading the pdf into Excel now ?

Try: Data > From File > From PDF to see how good or bad a job PQ does in reading your pdf file. You may find it recognises it as a table and you can import just that data.

 

[cboyce44]

I'm afraid that is not allowed under the forum rules.
If you can share it via dropbox, google drive etc we can take a look.

You mention not being able to hook up PQ to a program but how are you loading the pdf into Excel now ?

Try: Data > From File > From PDF to see how good or bad a job PQ does in reading your pdf file. You may find it recognises it as a table and you can import just that data.

Sorry I didn't know about not giving email addresses. Here is the link for OneDrive for you to download it.

https://zeiss-my.sharepoint.com/:f:...s/ExcelCert_WithCERTPDFs?csf=1&web=1&e=BoAO3Q

I have my excel workbook, and 3 example pdf certs to import.

Right now in my program I have the user select the Artifact Cal Cert pdf file. Once it opens, I have it convert the pdf file to an excel worksheet. Then I copy from the open workbook that the pdf creates, and paste that to the "PitchGageData" tab in my original workbook. I then close the pdf file that is open. ( Can't figure out how to close the opened workbook that the pdf creates, or delete it from where the user file path the user selected. Which is what I would like to do.) (Module2) Then your program (Module4) finds the "L1" and copies and pastes to the tab "Nominal Error Calculations" Cell A 60.

Please let me know if you can't get the download.

 

[Alex Blakenburg]

Sorry I can't access it, it needs to be made available to anyone who has the link. I am not sure if you sharepoint will let you do that.

 

[Alex Blakenburg]

If you can't get me a file, is there any text that is consistent and unique and always a certain number of rows and columns away from the row with L1, L2 etc ?
(give me an image showing the text and position away from the required data and showing the row numbers and column letters)

 

[smozgur]

@cboyce44: I've removed the previously marked solution in this thread as it appears that the discussion is ongoing. Please remember to mark the post as the solution once your question is successfully resolved.

 

[cboyce44]

If you can't get me a file, is there any text that is consistent and unique and always a certain number of rows and columns away from the row with L1, L2 etc ?
(give me an image showing the text and position away from the required data and showing the row numbers and column letters)

Alex,

I'm sorry I've been very busy. I will try to send it to you again. I think I had as private. Let me try one more time to send it to you.

Christopher Boyce sent you 4 items

93173188802.PDF + 3 more items

www.dropbox.com

 

[Alex Blakenburg]

Thanks, got it.

In your current pdf data PITCH appears by itself in a single cell, so I have opted to do a xlWhole match & case match on PITCH.
It this is not a consistent occurence we will need to revisit this.

In the meantime give this a try:

Sub FindAndCopy_v03_PITCH()

    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 = Worksheets("PitchGageData")
    Set wsDest = Worksheets("Nominal Error Calculations")
    Set rngDest = wsDest.Range("A60")
    
    ' Look for PITCH
    Set rngSrc = wsSrc.UsedRange.Find(What:="PITCH", LookIn:=xlFormulas, LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                        MatchCase:=True, SearchFormat:=False)
                                        
    If rngSrc Is Nothing Then Exit Sub
    
    With wsSrc
        colLast = .Cells(rngSrc.Row, Columns.Count).End(xlToLeft).Column
    End With
    
    Set rngSrc = rngSrc.Offset(, 1)
    Set rngSrc = rngSrc.Resize(1, colLast - rngSrc.Column + 1)
    cntItem = WorksheetFunction.CountA(rngSrc)
    
    ReDim arrDest(1 To 3, 1 To cntItem)
    
    For Each rCell In rngSrc
        If rCell <> "" Then
            i = i + 1
            arrDest(1, i) = rCell.Value
            arrDest(2, i) = rCell.Offset(1).Value
            arrDest(3, i) = rCell.Offset(2).Value
        End If
    Next rCell
    
    rngDest.Resize(3, i).Value = arrDest
                    
End Sub

 

[cboyce44]

Thanks, got it.

In your current pdf data PITCH appears by itself in a single cell, so I have opted to do a xlWhole match & case match on PITCH.
It this is not a consistent occurence we will need to revisit this.

In the meantime give this a try:

Sub FindAndCopy_v03_PITCH()

    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 = Worksheets("PitchGageData")
    Set wsDest = Worksheets("Nominal Error Calculations")
    Set rngDest = wsDest.Range("A60")
   
    ' Look for PITCH
    Set rngSrc = wsSrc.UsedRange.Find(What:="PITCH", LookIn:=xlFormulas, LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                        MatchCase:=True, SearchFormat:=False)
                                       
    If rngSrc Is Nothing Then Exit Sub
   
    With wsSrc
        colLast = .Cells(rngSrc.Row, Columns.Count).End(xlToLeft).Column
    End With
   
    Set rngSrc = rngSrc.Offset(, 1)
    Set rngSrc = rngSrc.Resize(1, colLast - rngSrc.Column + 1)
    cntItem = WorksheetFunction.CountA(rngSrc)
   
    ReDim arrDest(1 To 3, 1 To cntItem)
   
    For Each rCell In rngSrc
        If rCell <> "" Then
            i = i + 1
            arrDest(1, i) = rCell.Value
            arrDest(2, i) = rCell.Offset(1).Value
            arrDest(3, i) = rCell.Offset(2).Value
        End If
    Next rCell
   
    rngDest.Resize(3, i).Value = arrDest
                   
End Sub

So this seems to work. The only issue I'm running into, is when it copies from pdf workbook that is created, (93173188802.PDF) the "L1" pastes as "LI". So it doesn't update the results.

 

[Alex Blakenburg]

So this seems to work. The only issue I'm running into, is when it copies from pdf workbook that is created, (93173188802.PDF) the "L1" pastes as "LI". So it doesn't update the results.

Swap the For / Next loop to this:
Note: It is just matter of how conservative you want to be, this assumes that the pdf conversion has at least recognised the "L".

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