Loop with 2 offsets

Question

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

Maybe add some explanation of exactly what workbooks (multiple?) and worksheets are in use here. Also worth reviewing this post to get away from using Select/Activate in your code: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba/10717999#10717999 — Tim Williams, Dec 08 '22 at 18:08
I've cleaned up the explanation, thank you for pointing that out. — Knockoutpie, Dec 08 '22 at 18:17
You want the second instance of `str1` on "Export"? That's why the `FindNext` ? — Tim Williams, Dec 08 '22 at 18:21
Also not clear what the purpose of the `Do While Cntr <= 650` loop is — Tim Williams, Dec 08 '22 at 19:01
Sharing screenshots of your worksheets might clarify a lot. Don't you know the row or column where to find `ParNum` and `Leadtime`? — VBasic2008, Dec 08 '22 at 21:20

score 0 · Answer 1 · answered Dec 08 '22 at 18:50

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

score 0 · Answer 2 · answered Dec 08 '22 at 21:24

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

Loop with 2 offsets

2 Answers2