Help: VBA Macro to copy data from another spreadsheet while performing a check

derekstark

New Member
Joined
May 22, 2018
Messages
3
Here's the code I have. The first code box is to perform a check that Cell X in Workbook1 equals Cell Y in Workbook2, if successful it will continue to my second code box where it will pull the data from the designated cells and then paste it in the row where the active cell is currently located. The second code box needs an overhaul to designate the paste function into the active row, starting at the active cell.

I get errors trying to get the row where the active cell is currently located.


Here's the flow..
1. Command Button Click
2. Select File with data to be copied from (this workbook has static cells so data is being pulled from the same cell regardless of which spreadsheet)
3. Perform a check that workbook1 process number (static cell) matches process number in workbook 2 in the current row where active cell is located
4a. Success- Proceed to copy and paste data into active row beginning at active cell
4b. Fail- Error message and don't copy or paste.



Code:
Sub Foo()
 Dim vFile As Variant
 Dim wbCopyTo As Workbook
 Dim wsCopyTo As Worksheet
 Dim wbCopyFrom As Workbook
 Dim wsCopyFrom As Worksheet
  
 Set wbCopyTo = ActiveWorkbook
 Set wsCopyTo = ActiveSheet
  
     '-----------------------------<wbr>------------------------------<wbr>--
     'Open file with data to be copied
     
     vFile = Application.GetOpenFilename("<wbr>Excel Files (*.xl*)," & _
     "*.xl*", 1, "Select Excel File", "Open", False)
     
     'If Cancel then Exit
     If TypeName(vFile) = "Boolean" Then
         Exit Sub
     Else
     Set wbCopyFrom = Workbooks.Open(vFile)
     Set wsCopyFrom = wbCopyFrom.Worksheets(1)
     End If
     
     
     'If Process Number Matches
     ''''INSERT CODE FOR PROCESS NUMBER CHECK HERE
     
[B]Dim projectNumber As Long[/B]
[B]Dim column As Integer  [/B]
[B]Dim row As Integer[/B]
[B]Dim rng As Range[/B]
  
[B]'Set column and row to whatever row/column contains the Project Number in wsCopyFrom (could also use Range if its a particular cell)[/B]
[B]projectNumber = wsCopyFrom.Range("G5).Value[/B]
  
[B][COLOR=#ff0000]Set rng = wsCopyTo.Cells.EntireRow.Select[/COLOR] 'Get selected row in Active Worksheet[/B]
[B][COLOR=#ff0000]For Each c In rng.Cells    [/COLOR]' Check each cell in row/range[/B]
[B]    If c.Value = projectNumber   ' Project number was found[/B]
[B]        MsgBox("Project number found!")
[/B]
[B]        ' Insert copy and pasting code here.... See below[/B]
  
[B]    End If[/B]
[B]Next c[/B]
  
[B]' Project number was not found in selected range if you get to this point[/B]
[B] MsgBox("Project Number Does Not Match")


[/B]'Close file that was opened
     wbCopyFrom.Close SaveChanges:=False



Code:
    'Copy and Pasting

     wsCopyFrom.Range("F21").Copy
     wsCopyTo.Range("[B]Active Row, beginning at Active Cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("G21").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("L21").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B][B]"[/B]).<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("M21").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("R21").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("S21").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("G31").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("M31").<wbr>Copy
     wsCopyTo.Range(""[B]Active Row and Offset one column to the right from previous cell[/B]).<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("S31").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("F41").<wbr>Copy
     wsCopyTo.Range(""[B]Active Row and Offset one column to the right from previous cell[/B]).<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
     wsCopyFrom.Range("G41").<wbr>Copy
     wsCopyTo.Range("[B]Active Row and Offset one column to the right from previous cell[/B]").<wbr>PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top