Home > Software engineering >  VBA Excel copy data from one workbook to another when specified string appears in the row
VBA Excel copy data from one workbook to another when specified string appears in the row

Time:11-06

I have the situation presented below in the image (Workbook 1):

enter image description here

and below (Workbook 2)

I want to copy my record from workbook 1 to workbook 2 if

  • in the Workbook 1 column A the string "surveyor" appears
  • the value from column B, which is exactly in the same row, where the string "suveyor" was found.

Then I would like to copy this value to my workbook 2.

I have prepared the code like this:

 Sub FrontsheetAdd3()
 Dim x As Worksheet, y As Worksheet, sPath As String
 Dim i As Long

 sPath = ThisWorkbook.Path & "\Survey_form.csv"
 Set x = Workbooks.Open(sPath)

 Set y = ActiveWorkbook.Sheets("Frontsheet") 'set to current worksheet name

'Name of the sheet is the same as Name of the workbook 1
 If x.Sheets("Survey_form").Range("A" & i).Value = "surveyor" Then
 x.Sheets("Survey_form").Rage("B" & i).Value = ("A" & i)
 y.Sheets("Frontsheet").Range("D34").PasteSpecial
 End If
 Next i

 End Sub

I have an error:

Method or data member not found

at the line

   If x.Sheets("Survey_form").Range("A" & i).Value = "surveyor" Then

UPDATE:

After changing my code, which now looks like this:

 Sub FrontsheetAdd3()
 Dim x As Workbook, y As Workbook, sPath As String
 Dim i As Long

 sPath = ThisWorkbook.Path & "\Survey_form.csv"
 Set x = Workbooks.Open(sPath)

 Set y = ActiveWorkbook.Sheets("Frontsheet") 'set to current worksheet name

 'Name of the sheet is the same as Name of the workbook 1
  For i = 1 To 40
  If x.Sheets("Survey_form").Range("A" & i).Value = "surveyor" 
   Then
  x.Sheets("Survey_form").Rage("B" & i).Value = ("A" & i)
  y.Sheets("Frontsheet").Range("D34").PasteSpecial
  End If
  Next i

  End Sub

At the line:

      Set y = ActiveWorkbook.Sheets("Frontsheet") 'set to current worksheet name

my active workbook (Workbook2), where the macro is meant to be is closing down and error Subscript out of range emerges.

What is missig then?

CodePudding user response:

Please, try the next adapted code. It will copy from the csv file in the active one and exit loop:

Sub FrontsheetAdd3()
 Dim x As Workbook, y As Worksheet, ws As Worksheet, sPath As String, i As Long

  sPath = ThisWorkbook.path & "\Survey_form.csv"

  Set y = ActiveWorkbook.Sheets("Frontsheet") 'set to current worksheet name
  Set x = Workbooks.Open(sPath): Set ws = x.Sheets(1)

  For i = 1 To 40
    If ws.Range("A" & i).value = "surveyor" Then
        y.Range("D34").value = ws.Rage("B" & i).value: Exit For
    End If
  Next i
End Sub

CodePudding user response:

A VBA Lookup

  • Use Option Explicit which forces you to declare all variables.
  • Use variables (more of them) to make the code more readable.
  • Use meaningful variable names: sPath is a great name while x and y used for workbooks are terrible.
  • Instead of the loop, use Application.Match.
  • You can basically copy in three ways: Copy, Copy with PasteSpecial or Copy by Assignment (dCell.Value = sCell.Value) the latter being the most efficient when copying only values.
Option Explicit

Sub FrontsheetAdd3()

    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Frontsheet")
    Dim dCell As Range: Set dCell = dws.Range("D34")
    
    Dim sPath As String: sPath = dwb.Path & "\Survey_form.csv"
    Dim swb As Workbook: Set swb = Workbooks.Open(sPath)
    Dim sws As Worksheet: Set sws = wb.Worksheets("Survey_form")
    ' Determine the position of the first occurence of "surveyor" in column 'A'.
    Dim sIndex As Variant
    sIndex = Application.Match("surveyor", sws.Columns("A"), 0)
    
    If IsNumeric(sIndex) Then ' "suveyor" was found
        Dim sCell As Range: Set sCell = sws.Rows(sIndex).Columns("B")
        dCell.Value = sCell.Value
    Else ' "surveyor" was not found
        dCell.Value = ""
    End If

    swb.Close SaveChanges:=False
    'dwb.Save

End Sub
  • Related