VBA Import Data Only IF Material Matches

[Ottsel]

Struggling to create a loop within a loop. Overall, VBA isn't my strongest skill, but trying to improve when and where I can.

Currently, I have the code below that will grab my data and important it onto another sheet to be reviewed.

    Dim r As Long 'row
    Dim row As Long 'row count
  
    row = Sheets("OSB Invoice").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    '...Prevent from Forumlas filling all the way down
    'Application.ScreenUpdating = False
    Application.AutoCorrect.AutoFillFormulasInLists = False
    Application.DisplayAlerts = False
    
    '...Clear Slate
    Sheets("OSB CALC").Range("A8:E49").ClearContents
    Sheets("OSB INVOICE").Activate
    
    For r = 2 To row
            If Sheets("OSB INVOICE").Range("AA" & r).Value = "Import" Then
            Sheets("OSB INVOICE").Range(Range("AA" & r).Offset(0, 1), Sheets("OSB INVOICE").Range("AA" & r).Offset(0, 5)).Copy
            Sheets("OSB CALC").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            Application.CutCopyMode = False
            End If
    Next r

    Sheets("OSB CALC").Activate
    Range("F5").Select

Sheets("OSB INVOICE") contains my data or orders
Sheets("OSB CALC") contains my sorted table

In column AA I have a formula:

=IF(OR(D2<'OSB CALC'!$B$2,D2>'OSB CALC'!$E$2),"","Import")

If it says "Import" then I know it meets the criteria to be imported into the "OSB Calc" sheet.

Now, where everything imports to ("OSB Calc") the item code is listed in Range("A5") and the same item code can be found within Column A on ("OSB Invoice").
the idea is to be able to change the item code, hit 'import' and create multiple lists to be reviewed with ease.

Right now it just ignores the item overall and will import anything and everything within the OSB Invoice sheet no matter what the code is, but I would like it to match the code, then if it matches continue onto the next loop.

Any and all help would be greatly appreciated!

 

[HaHoBe]

Hi Ottsel,

what about

Public Sub MrE_1228766_1702516()
' https://www.mrexcel.com/board/threads/vba-import-data-only-if-material-matches.1228766/
  Dim lngCounter As Long      'counter for loop
  Dim lngRowCount As Long     'number of constants
  Dim wsCalc As Worksheet
  Dim wsInv As Worksheet
  
  Set wsInv = Worksheets("OSB Invoice")
  Set wsCalc = Worksheets("OSB CALC")
  
  '...Prevent from Forumlas filling all the way down
  'Application.ScreenUpdating = False
  Application.AutoCorrect.AutoFillFormulasInLists = False
  Application.DisplayAlerts = False
  
  wsCalc.Range("A8:E49").ClearContents
  With wsInv
    lngRowCount = .Range("A:A").SpecialCells(xlCellTypeConstants).Count
    For lngCounter = 2 To lngRowCount
      If .Range("AA" & lngCounter).Value = "Import" Then
        .Range("AA" & lngCounter).Offset(0, 1).Resize(1, 5).Copy
        wsCalc.Cells(wsCalc.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
      End If
    Next lngCounter
  End With
  
  Application.Goto wsCalc.Range("F5"), True
  Application.DisplayAlerts = False
  Set wsCalc = Nothing
  Set wsInv = Nothing
End Sub

Ciao,
Holger

 

[Ottsel]

Hi Ottsel,

what about

Public Sub MrE_1228766_1702516()
' https://www.mrexcel.com/board/threads/vba-import-data-only-if-material-matches.1228766/
  Dim lngCounter As Long      'counter for loop
  Dim lngRowCount As Long     'number of constants
  Dim wsCalc As Worksheet
  Dim wsInv As Worksheet
 
  Set wsInv = Worksheets("OSB Invoice")
  Set wsCalc = Worksheets("OSB CALC")
 
  '...Prevent from Forumlas filling all the way down
  'Application.ScreenUpdating = False
  Application.AutoCorrect.AutoFillFormulasInLists = False
  Application.DisplayAlerts = False
 
  wsCalc.Range("A8:E49").ClearContents
  With wsInv
    lngRowCount = .Range("A:A").SpecialCells(xlCellTypeConstants).Count
    For lngCounter = 2 To lngRowCount
      If .Range("AA" & lngCounter).Value = "Import" Then
        .Range("AA" & lngCounter).Offset(0, 1).Resize(1, 5).Copy
        wsCalc.Cells(wsCalc.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
      End If
    Next lngCounter
  End With
 
  Application.Goto wsCalc.Range("F5"), True
  Application.DisplayAlerts = False
  Set wsCalc = Nothing
  Set wsInv = Nothing
End Sub

Ciao,
Holger

That worked!. Thank you for that - I had to made a few adjustments with the referencing and protections, but overall worked fast and is very effective.

This'll help for the future on my overall structuring. Thanks again!

 

[HaHoBe]

Hi Ottsel,

glad we could help on this one and thanks for the feedback.

And looking at the code by now instead of

        .Range("AA" & lngCounter).Offset(0, 1).Resize(1, 5).Copy

you can use either

        .Range("AB" & lngCounter).Resize(1, 5).Copy

or

        .Range("AB" & lngCounter & ":AF" & lngCounter).Copy

Holger

 

[Ottsel]

Hi Ottsel,

glad we could help on this one and thanks for the feedback.

And looking at the code by now instead of

        .Range("AA" & lngCounter).Offset(0, 1).Resize(1, 5).Copy

you can use either

        .Range("AB" & lngCounter).Resize(1, 5).Copy

or

        .Range("AB" & lngCounter & ":AF" & lngCounter).Copy

Holger

appreciate the different examples! Always handy to see on projects.