VBA copy row of data to another workbook.

[EdwardSurrey]

Hello

Please can I have some help with a macro I am trying to create?

I have a single row row of data in Workbook A, with the first column containing an ID number.

In a Workbook B I have table full of data, where I want to add this row of data to.

I'd like a button in Workbook A that will do the following

1) look at the list of ID numbers in Workbook B.
2) If it sees the same ID number as in Workbook A, replace the entire row in the table with the one from Workbook A (values only)
3) If the ID is not in there, find the first empty row (at the bottom of the table) and copy the row there.

Workbook A is basically a form that I will regularly be putting new rows of data in, needing them sent to Workbook B table.

Apologies if I explained this in a convoluted way. Is this something anyone can help with? Thank you

 

[ZMyrrh]

If you can it would be very helpful if you could add pictures of the workbooks including the workbook name and sheet names and ranges.

 

[EdwardSurrey]

If you can it would be very helpful if you could add pictures of the workbooks including the workbook name and sheet names and ranges.

Apologies. This is Workbook A with the sheet called "SendToDatabase". I have shown you just three columns but there are many more. I want to click a button and that whole Row 9 should be send to Workbook B.

The sheet I want to copy to in Workbook B is called "Win Loss Reports". It looks exactly the same as "SendToDatabase" in Workbook A, except is has many lines of data from previous submissions. I literally want the button to check if the ID in column B is already there, in which case replace the row, otherwise add to the bottom of the dataset.

Thanks and I hope this is enough info!

 

[ZMyrrh]

Sub ButtonClick10()
Dim LastRow As Long
Dim ID As Long
Dim WkBkA As String: Let WkBkA = "Book1"
Dim WkBkAWkSht As String: Let WkBkAWkSht = "SendToDataBase"
Dim WkBkB As String: Let WkBkB = "Book1"
Dim WkBkBWkSht As String: Let WkBkBWkSht = "Win Loss Reports"
Dim actWork As String
Dim actSheet As String
Dim I As Integer
Dim Pasted As Boolean

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Let actWork = ActiveWorkbook.Name
Let actSheet = ActiveSheet.Name

For j = 7 To 40
If Workbooks(WkBkA).Worksheets(WkBkAWkSht).Cells(j, 2).Value <> "" Then

Workbooks(WkBkA).Activate
Worksheets(WkBkAWkSht).Activate
Pasted = False
ID = Cells(j, 2).Value
LastRow = WorksheetFunction.CountA(Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range("b7:b50000")) + 7
Workbooks(WkBkA).Worksheets(WkBkAWkSht).Range(Cells(j, 2), Cells(j, Cells(j, 2).End(xlToRight).Column)).Copy

For I = 7 To WorksheetFunction.CountA(Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range("b7:b50000")) + 6

   
    If Workbooks(WkBkB).Worksheets(WkBkBWkSht).Cells(I, 2).Value = ID And Pasted = False Then
   
        Workbooks(WkBkB).Activate
        Worksheets(WkBkBWkSht).Activate
        Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range(Cells(I, 2), Cells(I, Cells(I, 2).End(xlToRight).Column)).PasteSpecial xlPasteValues
        Pasted = True
       
    End If

Next I
   
    If Pasted = False Then
       
        Workbooks(WkBkB).Activate
        Worksheets(WkBkBWkSht).Activate
        Range(Cells(LastRow, 2), Cells(LastRow, Cells(LastRow, 2).End(xlToRight).Column)).PasteSpecial xlPasteValues
       
   
    End If
   

End If

Next j

Workbooks(actWork).Activate
Worksheets(actSheet).Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
   
End Sub

Try this out. If you need any changes just let me know. You will need to change the Workbook Name of both the workbook variables.

 

[EdwardSurrey]

Sub ButtonClick10()
Dim LastRow As Long
Dim ID As Long
Dim WkBkA As String: Let WkBkA = "Book1"
Dim WkBkAWkSht As String: Let WkBkAWkSht = "SendToDataBase"
Dim WkBkB As String: Let WkBkB = "Book1"
Dim WkBkBWkSht As String: Let WkBkBWkSht = "Win Loss Reports"
Dim actWork As String
Dim actSheet As String
Dim I As Integer
Dim Pasted As Boolean

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Let actWork = ActiveWorkbook.Name
Let actSheet = ActiveSheet.Name

For j = 7 To 40
If Workbooks(WkBkA).Worksheets(WkBkAWkSht).Cells(j, 2).Value <> "" Then

Workbooks(WkBkA).Activate
Worksheets(WkBkAWkSht).Activate
Pasted = False
ID = Cells(j, 2).Value
LastRow = WorksheetFunction.CountA(Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range("b7:b50000")) + 7
Workbooks(WkBkA).Worksheets(WkBkAWkSht).Range(Cells(j, 2), Cells(j, Cells(j, 2).End(xlToRight).Column)).Copy

For I = 7 To WorksheetFunction.CountA(Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range("b7:b50000")) + 6

  
    If Workbooks(WkBkB).Worksheets(WkBkBWkSht).Cells(I, 2).Value = ID And Pasted = False Then
  
        Workbooks(WkBkB).Activate
        Worksheets(WkBkBWkSht).Activate
        Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range(Cells(I, 2), Cells(I, Cells(I, 2).End(xlToRight).Column)).PasteSpecial xlPasteValues
        Pasted = True
      
    End If

Next I
  
    If Pasted = False Then
      
        Workbooks(WkBkB).Activate
        Worksheets(WkBkBWkSht).Activate
        Range(Cells(LastRow, 2), Cells(LastRow, Cells(LastRow, 2).End(xlToRight).Column)).PasteSpecial xlPasteValues
      
  
    End If
  

End If

Next j

Workbooks(actWork).Activate
Worksheets(actSheet).Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  
End Sub

Try this out. If you need any changes just let me know. You will need to change the Workbook Name of both the workbook variables.

This works! thank you The only issue is I need to have Workbook B open in order for the macro to work. Workbook B sits in a Sharepoint location. Is it possible to open in the background and then have it close once the Macro is done?

 

[EdwardSurrey]

Sub ButtonClick10()
Dim LastRow As Long
Dim ID As Long
Dim WkBkA As String: Let WkBkA = "Book1"
Dim WkBkAWkSht As String: Let WkBkAWkSht = "SendToDataBase"
Dim WkBkB As String: Let WkBkB = "Book1"
Dim WkBkBWkSht As String: Let WkBkBWkSht = "Win Loss Reports"
Dim actWork As String
Dim actSheet As String
Dim I As Integer
Dim Pasted As Boolean

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Let actWork = ActiveWorkbook.Name
Let actSheet = ActiveSheet.Name

For j = 7 To 40
If Workbooks(WkBkA).Worksheets(WkBkAWkSht).Cells(j, 2).Value <> "" Then

Workbooks(WkBkA).Activate
Worksheets(WkBkAWkSht).Activate
Pasted = False
ID = Cells(j, 2).Value
LastRow = WorksheetFunction.CountA(Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range("b7:b50000")) + 7
Workbooks(WkBkA).Worksheets(WkBkAWkSht).Range(Cells(j, 2), Cells(j, Cells(j, 2).End(xlToRight).Column)).Copy

For I = 7 To WorksheetFunction.CountA(Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range("b7:b50000")) + 6

  
    If Workbooks(WkBkB).Worksheets(WkBkBWkSht).Cells(I, 2).Value = ID And Pasted = False Then
  
        Workbooks(WkBkB).Activate
        Worksheets(WkBkBWkSht).Activate
        Workbooks(WkBkB).Worksheets(WkBkBWkSht).Range(Cells(I, 2), Cells(I, Cells(I, 2).End(xlToRight).Column)).PasteSpecial xlPasteValues
        Pasted = True
      
    End If

Next I
  
    If Pasted = False Then
      
        Workbooks(WkBkB).Activate
        Worksheets(WkBkBWkSht).Activate
        Range(Cells(LastRow, 2), Cells(LastRow, Cells(LastRow, 2).End(xlToRight).Column)).PasteSpecial xlPasteValues
      
  
    End If
  

End If

Next j

Workbooks(actWork).Activate
Worksheets(actSheet).Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  
End Sub

Try this out. If you need any changes just let me know. You will need to change the Workbook Name of both the workbook variables.

One more thing, the filename of Workbook A is Win Loss Form Template but users will change the file name when they fill in the form. Cant this by dynamic?

 

[EdwardSurrey]

This works! thank you The only issue is I need to have Workbook B open in order for the macro to work. Workbook B sits in a Sharepoint location. Is it possible to open in the background and then have it close once the Macro is done?

I have solved this by doing an Open & Close statement in the VBA

 

[ZMyrrh]

If you are still looking to change the Workbook A to a dynamic name I would change all the WkBkA to actWork. Then it should get the name of the current workbook and use that name instead of needing to put the workbook name in.

 

[EdwardSurrey]

If you are still looking to change the Workbook A to a dynamic name I would change all the WkBkA to actWork. Then it should get the name of the current workbook and use that name instead of needing to put the workbook name in.

I managed to solve by changing to ThisWorkbook. Thanks again for your help - My colleagues are super happy with what I've been able to achieve as a result. I marked your answer as the solution.