Loop Through Rows To Find Value And Copy Data

Question

I have a Workbook that imports data from a vendor sheet. The vendor Worksheet Column A is dynamic so it will change from time to time. The import file should copy the appropriate data to an input sheet in my workbook so the data can be verified before transferring to a log. I created a For Loop to loop through all the rows in column A looking for a specific value. Once the value is found I used the OFFSET function to copy data from different columns in the same row. As you will see they are not successive columns. The code works fine for copying data from one column, however when I try to copy all the necessary data from each column it returns nothing. Could you please help me understand why this is happening? Thank you so very much for any and all help.

Sub ImportData()

Dim FileOpen As Variant
Dim OpenBook As Workbook
Dim i As Integer

Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files(*.xls*),*xls*")

If FileOpen <> False Then

    Set OpenBook = Application.Workbooks.Open(FileOpen)

    OpenBook.Sheets(1).Range("E11:F100").Replace What:="U", Replacement:=""
    OpenBook.Sheets(1).Range("E11:F100").Replace What:="i", Replacement:=""


    'Date & Time
    OpenBook.Sheets(1).Range("E9").Copy
    ThisWorkbook.Worksheets("Input").Range("B10").PasteSpecial xlPasteValues
    OpenBook.Sheets(1).Range("E10").Copy
    ThisWorkbook.Worksheets("Input").Range("B11").PasteSpecial xlPasteValues
    OpenBook.Sheets(1).Range("F9").Copy
    ThisWorkbook.Worksheets("Input").Range("C10").PasteSpecial xlPasteValues
    OpenBook.Sheets(1).Range("F10").Copy
    ThisWorkbook.Worksheets("Input").Range("C11").PasteSpecial xlPasteValues
    'Plant Name
    OpenBook.Sheets(1).Range("B4").Copy
    ThisWorkbook.Worksheets("Input").Range("D11").PasteSpecial xlPasteValues
    'pH
    For i = 11 To 100
        If OpenBook.Sheets(1).Range("A" & i).Value = "Sales" Then
            OpenBook.Sheets(1).Range("A" & i).Offset(0, 5).Copy
            ThisWorkbook.Worksheets("Input").Range("B24").PasteSpecial xlPasteValues
            OpenBook.Sheets(1).Range("A" & i).Offset(0, 6).Copy
            ThisWorkbook.Worksheets("Input").Range("C24").PasteSpecial xlPasteValues
            OpenBook.Sheets(1).Range("A" & i).Offset(0, 2).Copy
            ThisWorkbook.Worksheets("Input").Range("D24").PasteSpecial xlPasteValues
        End If
    Next i
    OpenBook.Close False
End If
Application.ScreenUpdating = True

End Sub

Answer 1

This is your code with the added extra, of increasing row numbers on the import sheet for each new row of data, as well as avoiding the copy paste function.

Sub ImportData()

Dim FileOpen As Variant
Dim OpenBook As Workbook
Dim i As Integer
Dim RNmbr As Integer ' Row Number on the import sheet

Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files(*.xls*),*xls*")

If FileOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileOpen)

OpenBook.Sheets(1).Range("E11:F100").Replace What:="U", Replacement:=""
OpenBook.Sheets(1).Range("E11:F100").Replace What:="i", Replacement:=""

'Date & Time
ThisWorkbook.Worksheets("Input").Range("B10").Value = OpenBook.Sheets(1).Range("E9").Value
ThisWorkbook.Worksheets("Input").Range("B11").Value = OpenBook.Sheets(1).Range("E10").Value
ThisWorkbook.Worksheets("Input").Range("C10").Value = OpenBook.Sheets(1).Range("F9").Value
ThisWorkbook.Worksheets("Input").Range("C11").Value = OpenBook.Sheets(1).Range("F10").Value
'Plant Name
ThisWorkbook.Worksheets("Input").Range("D11").Value = OpenBook.Sheets(1).Range("B4").Value

'pH

RNmbr = 24 ' This is the starting row number

For i = 11 To 100
    If OpenBook.Sheets(1).Range("A" & i).Value = "Sales" Then
        ThisWorkbook.Worksheets("Input").Range("B" & RNmbr).Value = OpenBook.Sheets(1).Range("A" & i).Offset(0, 5).Value
        ThisWorkbook.Worksheets("Input").Range("C" & RNmbr).Value = OpenBook.Sheets(1).Range("A" & i).Offset(0, 6).Value
        ThisWorkbook.Worksheets("Input").Range("D" & RNmbr).Value = OpenBook.Sheets(1).Range("A" & i).Offset(0, 2).Value
        RNmbr = RNmbr + 1 ' increase the row number ready for the next set of data import
    End If
Next i  
  
OpenBook.Close False
End If

Application.ScreenUpdating = True
End Sub

Please be aware, every time this script runs it will overwrite any data currently on the import sheet from the row number specified. If you want to keep previous data then you will need to find the last row of data and set that as the RNmb