Loop with 2 offsets-CodePudding

done quite a bit of research and I cannot quite figure this out.. This is one workbook, searching between Sheet "Quote" and sheet "Export"

This script should be

searching for "PartNum" starting in Quote sheet once found
moves down 2 cells
Copies the value on the new active cell
searches for that value in worksheet "export"
once found copies the value offset 24 cells to the right
returns to worksheet "quote"
Finds "Leadtime"
move down 2 cells and pastes the value

The part i'm stuck on, I didn't write this correctly to loop as i would like, how can i accurately loop 1 row lower each time for BOTH Partnum and Leadtime? Is there any way I can add so it ignores if a part is not found instead of erroring out?

   'Find PartNum
Worksheets("Quote").Activate
Cells.Find(What:="PartNum").Offset(2, 0).Select

'Copy/search part Num

   Dim str1 As String
    Dim Cntr As Integer
    Cntr = 0
    Do While Cntr <= 650

      Cntr = Cntr   1
      str1 = ActiveCell.Value
      Selection.Copy

      Worksheets("Export").Activate
      ActiveCell.Select
      Cells.Find(What:=str1, After:=ActiveCell, LookIn:= _
        xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
      Cells.FindNext(After:=ActiveCell).Activate
      ActiveCell.Offset(0, 24).Range("A1").Select
      Selection.Copy

      Worksheets("Quote").Activate
     
     
'Find PartNum
Cells.Find(What:="Leadtime").Offset(2, 0).Select
      Selection.PasteSpecial Paste:=xlPasteValues

CodePudding user response：

Some things to try.

RE: how can i accurately loop 1 row lower each time for BOTH Partnum and Leadtime?

Use ".Offset(3, 0).Select"

RE: Part not found

replace "Cells.Find(What:="PartNum").Offset(2, 0).Select" with:

Dim PN As Range
Set PN = Cells.Find(What:="PartNum")

If PN Is Nothing Then
    MsgBox ("Part Number is not found")
    'Exit Sub?
End If

PN.Offset(3, 0).Select

CodePudding user response：

Based on what I can gather from your posted code, but need some clarification around what you're doing on "export" sheet...

Option Explicit

Sub CopyData()

    Dim wsQuote As Worksheet, wsExport As Worksheet, wb As Workbook
    Dim str1 As String, f As Range, f2 As Range
    
    'use an explicit workbook reference
    Set wb = ThisWorkbook 'or ActiveWorkbook for example
    Set wsQuote = wb.Worksheets("Quote")
    Set wsExport = wb.Worksheets("Export")

    Set f = FindWholeValue(wsQuote.Cells, "PartNum")
    If f Is Nothing Then Exit Sub
    
    str1 = f.Offset(2, 0).Value 'two rows down from "PartNum"

    '------------------
    'Can't figure out what you're doing on the Export sheet...
    '
    '  Set f2 = ???
    '------------------
    
    Set f = FindWholeValue(wsQuote.Cells, "Leadtime")
    If f Is Nothing Then Exit Sub
    
    f.Offset(2, 0).Value = f2.Value
    
End Sub

'Search `rng` for `v` and return the first matched cell
'If not found and `WarnIfMissing` is True, warn the user
Function FindWholeValue(rng As Range, v, Optional WarnIfMissing As Boolean = True) As Range
    Set FindWholeValue = rng.Find(what:=v, lookat:=xlWhole, LookIn:=xlFormulas)
    If FindWholeValue Is Nothing And WarnIfMissing Then
        MsgBox "Value '" & v & "' not found on sheet '" & rng.Parent.Name & "'"
    End If
End Function