How to stop InputBox from looping after input?

[qplsn9]

Hi there! I am using this macro to sort through a master inventory list and transfer a row if the inputted "Vendor" is found when the InputBox populates. However, after the input, the InputBox keeps popping up and infinitely looping. How do I make it so that once a vendor name is entered, the code loops through the rows normally until the end of the master inventory list? Basically, I just want it to stop infinitely looping and to search for and copy the rows that contain the inputted vendor name. Thank you!

Sub For_RangeCopy2()

' Get the worksheets
Dim shRead As Worksheet
Set shRead = ThisWorkbook.Worksheets("Master")

Dim shWrite As Worksheet
Set shWrite = ThisWorkbook.Worksheets("PO Template")

' Get the range
Dim rg As Range
Set rg = shRead.Range("A1").CurrentRegion

With shWrite


End With

' Read through the data
Dim i As Long, row As Long
row = 1
For i = 1 To rg.Rows.Count
Dim vendor As String
vendor = InputBox("Type Vendor Name")



If rg.Cells(i, 3).Value2 = vendor Or i = 1 Then


' Copy using Range.Copy
rg.Rows(i).Copy
shWrite.Range("A" & row).PasteSpecial xlPasteValues

' move to the next output row
row = row + 1

End If

Next i

End Sub

 

[DanteAmor]

You must put the input box outside the FOR loop

Sub For_RangeCopy2()

  ' Get the worksheets
  Dim shRead As Worksheet
  Set shRead = ThisWorkbook.Worksheets("Master")
  
  Dim shWrite As Worksheet
  Set shWrite = ThisWorkbook.Worksheets("PO Template")
  
  ' Get the range
  Dim rg As Range
  Set rg = shRead.Range("A1").CurrentRegion
  
  With shWrite
  
  
  End With
  
  ' Read through the data
  Dim i As Long, row As Long
  row = 1
  
  Dim vendor As String
  vendor = InputBox("Type Vendor Name")
  
  For i = 1 To rg.Rows.Count
    If rg.Cells(i, 3).Value2 = vendor Or i = 1 Then
    
      ' Copy using Range.Copy
      rg.Rows(i).Copy
      shWrite.Range("A" & row).PasteSpecial xlPasteValues
      
      ' move to the next output row
      row = row + 1
    
    End If
  
  Next i

End Sub

 

[DanteAmor]

Or try This

Sub For_RangeCopy_3()
  Dim vendor As String
  
  With ThisWorkbook.Worksheets("Master")
    vendor = InputBox("Type Vendor Name")
    If vendor = "" Then Exit Sub
    
    .Range("A1").CurrentRegion.AutoFilter 3, vendor
    .AutoFilter.Range.EntireRow.Copy ThisWorkbook.Worksheets("PO Template").Range("A1")
    .AutoFilterMode = False
  End With
End Sub

 

[qplsn9]

Or try This

Sub For_RangeCopy_3()
  Dim vendor As String
 
  With ThisWorkbook.Worksheets("Master")
    vendor = InputBox("Type Vendor Name")
    If vendor = "" Then Exit Sub
   
    .Range("A1").CurrentRegion.AutoFilter 3, vendor
    .AutoFilter.Range.EntireRow.Copy ThisWorkbook.Worksheets("PO Template").Range("A1")
    .AutoFilterMode = False
  End With
End Sub

Thank you! How would I adjust the code so that rather than copying the entire row, only a specific range is copied (like B:E)?

 

[DanteAmor]

How would I adjust the code so that rather than copying the entire row, only a specific range is copied (like B:E)?

Try:

Sub For_RangeCopy_3()
  Dim vendor As String
  Dim lr As Long
  
  Application.ScreenUpdating = False
  
  With ThisWorkbook.Worksheets("Master")
    vendor = InputBox("Type Vendor Name")
    lr = .UsedRange.Rows(.UsedRange.Rows.Count).row
    If vendor = "" Then Exit Sub
    
    .Range("A1").CurrentRegion.AutoFilter 3, vendor
    .AutoFilter.Range.Range("B1:E" & lr).Copy ThisWorkbook.Worksheets("PO Template").Range("A1")
    .AutoFilterMode = False
  End With
  Application.ScreenUpdating = True
End Sub

 

[qplsn9]

Try:

Sub For_RangeCopy_3()
  Dim vendor As String
  Dim lr As Long
 
  Application.ScreenUpdating = False
 
  With ThisWorkbook.Worksheets("Master")
    vendor = InputBox("Type Vendor Name")
    lr = .UsedRange.Rows(.UsedRange.Rows.Count).row
    If vendor = "" Then Exit Sub
   
    .Range("A1").CurrentRegion.AutoFilter 3, vendor
    .AutoFilter.Range.Range("B1:E" & lr).Copy ThisWorkbook.Worksheets("PO Template").Range("A1")
    .AutoFilterMode = False
  End With
  Application.ScreenUpdating = True
End Sub

Thank you so so much! One last thing, how would I limit the code so that it only copies 21 items at a time?

Also, is there a way to copy so that only the values of the cells are copied rather than the conditional formatting associated with it as well? Thanks so much!

 

[DanteAmor]

One last thing

It's never the last time, haha, I've been in systems for 30 years and it's never the last time.
But don't worry, I'll be happy to help you with the following.

how would I limit the code so that it only copies 21 items at a time?

What do you mean 21 items, first 21, last 21, random 21 items. That was not in your macro or in your initial requirement.

is there a way to copy so that only the values

For that try the following:

Sub For_RangeCopy_3()
  Dim vendor As String
  Dim lr As Long
  
  Application.ScreenUpdating = False
  
  With ThisWorkbook.Worksheets("Master")
    vendor = InputBox("Type Vendor Name")
    lr = .UsedRange.Rows(.UsedRange.Rows.Count).row
    If vendor = "" Then Exit Sub
    
    .Range("A1").CurrentRegion.AutoFilter 3, vendor
    .AutoFilter.Range.Range("B1:E" & lr).Copy
    ThisWorkbook.Worksheets("PO Template").Range("A1").PasteSpecial xlPasteValues
    .AutoFilterMode = False
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

 

[qplsn9]

It's never the last time, haha, I've been in systems for 30 years and it's never the last time.
But don't worry, I'll be happy to help you with the following.


What do you mean 21 items, first 21, last 21, random 21 items. That was not in your macro or in your initial requirement.



For that try the following:

Sub For_RangeCopy_3()
  Dim vendor As String
  Dim lr As Long
 
  Application.ScreenUpdating = False
 
  With ThisWorkbook.Worksheets("Master")
    vendor = InputBox("Type Vendor Name")
    lr = .UsedRange.Rows(.UsedRange.Rows.Count).row
    If vendor = "" Then Exit Sub
   
    .Range("A1").CurrentRegion.AutoFilter 3, vendor
    .AutoFilter.Range.Range("B1:E" & lr).Copy
    ThisWorkbook.Worksheets("PO Template").Range("A1").PasteSpecial xlPasteValues
    .AutoFilterMode = False
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

hahaha, i appreciate your system wisdom about "never being the last time" lol. for the 21 items, i want it to copy items by vendor but only 21 items at a time. so for example, i want it a vendor input by the user (Let's say "VWR") and there are 41 items with VWR as the vendor. How can I make it so that it only grabs the first 21 items with VWR as the vendor and either 1) then grabs the last 20 or 2) the user can input the vendor again and it will grab the final 20 items? not sure if that makes sense and if not, no worries! you've been such a wonderful help :D