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]

I tried this. It works for the other 2 pdf certs, but the same thing is happening with the 93173188802.pdf. The Workbook that is created the chart looks like this:

However, when it copies and pastes the entire Workbook using this code:

to "PitchGageData" tab A1, this is what it looks like:

As you can see, it changes the "L1" clearly seen in the workbook that is created from the PDF file, to "LI", and even changes the value of "-0.1" to "-0.I" I don't know why this is happening. Do you suggest I do something different than just copy and paste? If so, what is a better way of doing it?


Thank you SO much for all of your help!

 

[Alex Blakenburg]

As you can see, it changes the "L1" clearly seen in the workbook that is created from the PDF file, to "LI", and even changes the value of "-0.1" to "-0.I" I don't know why this is happening. Do you suggest I do something different than just copy and paste? If so, what is a better way of doing it?

Your PDF files look to be pictures rather than computer generated PDF files.
Power Query can't read them. They are also fairly poor quality images and the Text conversion utilities are not doing a good job on them.

I have made some minor modifications to the code, see if that is enough to overcome the "I" issue.

Sub FindAndCopy_v05_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:=False, 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
            If Left(rCell, 1) = "L" Then
                arrDest(1, i) = "L" & i
            Else
                arrDest(1, i) = rCell.Value
            End If
            arrDest(2, i) = CDec(Replace(rCell.Offset(1).Value, "I", 1))
            arrDest(3, i) = CDec(Replace(rCell.Offset(2).Value, "I", 1))
        End If
    Next rCell
    
    rngDest.Resize(3, i).Value = arrDest
                    
End Sub

 

[cboyce44]

I keep getting this?

 

[Alex Blakenburg]

Try replacing the first 2 lines below with the 2nd 2 lines.
But it means one of the values is not being recognised as a number so you will need to tell/show me what the output is that is not correct, to see how we can address it.

'            arrDest(2, i) = CDec(Replace(rCell.Offset(1).Value, "I", 1))
'            arrDest(3, i) = CDec(Replace(rCell.Offset(2).Value, "I", 1))
            
            arrDest(2, i) = Replace(rCell.Offset(1).Value, "I", 1)
            arrDest(3, i) = Replace(rCell.Offset(2).Value, "I", 1)

 

[cboyce44]

Try replacing the first 2 lines below with the 2nd 2 lines.
But it means one of the values is not being recognised as a number so you will need to tell/show me what the output is that is not correct, to see how we can address it.

'            arrDest(2, i) = CDec(Replace(rCell.Offset(1).Value, "I", 1))
'            arrDest(3, i) = CDec(Replace(rCell.Offset(2).Value, "I", 1))
           
            arrDest(2, i) = Replace(rCell.Offset(1).Value, "I", 1)
            arrDest(3, i) = Replace(rCell.Offset(2).Value, "I", 1)

Sorry this has taken me so long to get back with you. I have been very busy. I replaced the code with what you said above. It worked, but it didn't change one of the results from an "I" to a "1". Here is what it looks like in sheet "Nominal Error Calculations", Cell A60

At least it worked this time with no errors! Just need to somehow make it look for the answers in cells A62 - F62 to see if an "I is in any of the cells, and change it to a "1"?

 

[Alex Blakenburg]

Try changing the last line just before the End Sub to this:

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

 

[cboyce44]

Try changing the last line just before the End Sub to this:

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

Still did the same thing

 

[Alex Blakenburg]

It looks like it is not a capital "i". Can you copy the character and paste it where the "I" is in that last line I gave you.

 

[cboyce44]

It looks like it is not a capital "i". Can you copy the character and paste it where the "I" is in that last line I gave you.

So I copied, and pasted the character. It pasted as a "1"! When I ran it though, it worked perfect!

Thank you SO much for all of your help! It works perfect now.

 

[Alex Blakenburg]

No problem, glad we could help.