Moving row from one workbook to another - vba

Question

I am new to StackOverflow, but have been working on this problem for some time, and am pretty stuck. Right now, my code takes 'Name' input from a textbox, and if the data in column A matches the name that was input, it copies data from the entire row in that sheet, copies it to another sheet, then deletes the data from the original sheet, and tells the user how many rows were moved. This code is listed below:
I have two problems. One, I need an error check where if the name that is typed into the textbox does not exist, it displays a messagebox with that message, and two, I need to allow for this code to do what it does, but from seperate workbooks. As in, copy the data from a sheet in one workbook, and move it to a sheet in another workbook. My code only works within the same workbook right now.
Any and all help is appreciated. Thank you in advance.
Private Sub buttonDelete_Click()
'When the Delete button is clicked, the following function is ran to copy the row from Current Services, move it to Cancelled Services
'and then delete the row from Current Services.
Dim wkBk1 As Workbook
Dim wkBk2 As Workbook
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
Dim count As Long
On Error Resume Next
Set wkBk1 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro.xlsm")
Set wkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro2.xlsm")
If Err.Number = 1004 Then
MsgBox "File Does Not Exist"
End If
I = wkBk1.Worksheets("Current Customers").UsedRange.Rows.count
J = Worksheets("Cancelled Services").UsedRange.Rows.count
count = 0
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Cancelled Services").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Current Customers").Range("A1:A" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.count
If CStr(xRg(K).Value) = Me.fName.Value Then
count = count + 1
xRg(K).EntireRow.Copy Destination:=Worksheets("Cancelled Services").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = Me.fName.Value Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
MsgBox count & " rows moved"
End Sub
EDIT : OK, here is one more wrinkle. What if I wanted to search through four or five different workbooks, and move all of the rows where the conditions are met into one worksheet called 'Cancelled Services' that will be a worksheet in one of the aforementioned workbooks.

Answer 1

There are a LOT of strange things going on in your code, so I've tried to clean it up a bit and left some comments as to why you shouldn't have some things in there. I've addressed the first part of your question, but in order to move rows between workbooks you need to decide what data you're looking to move and where, especially by fully qualifying your ranges using Workbook, or in your case, wkBk1 and wkBk2
Private Sub buttonDelete_Click()
'When the Delete button is clicked, the following function is ran to copy the row from Current Services, move it to Cancelled Services
'and then delete the row from Current Services.
Dim wkBk1 As Workbook, wkBk2 As Workbook
Dim xRg As Range, xCell As Range
Dim I As Long, J As Long, K As Long, count As Long
Dim MyName As String
'Assign our name value here
MyName = Me.fName.Value
'Let's use an error handler instead - this way our Err.Number will actually be triggered
On Error GoTo Handler
Set wkBk1 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro.xlsm")
Set wkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro2.xlsm")
On Error GoTo 0
I = wkBk1.Worksheets("Current Customers").UsedRange.Rows.count
J = Worksheets("Cancelled Services").UsedRange.Rows.count 'Need to add either wkBk1 or wkBk2 to the front of this
'We don't really NEED this, as count is initialized as 0 anyways
'count = 0
If J = 1 Then
'What is the purpose of this? Can it ever even return true if J = 1?
If Application.WorksheetFunction.CountA(Worksheets("Cancelled Services").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Current Customers").Range("A1:A" & I) 'Need to add either wkBk1 or wkBk2 to the front of this
'Here we check the range for the name. If it's not there, we throw a messsage box and exit the sub
If Not WorksheetFunction.CountIf(xRg, MyName) > 0 Then
MsgBox "Name doesn't exist in the range"
Exit Sub
End If
'Got rid of On Error Resume Next, we don't need it and it's sloppy coding
Application.ScreenUpdating = False
'This whole snippet needs to be changed
'Also since you're deleting rows, you need to step BACKWARDS through this loop
For K = 1 To xRg.count
If CStr(xRg(K).Value) = MyName Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Cancelled Services").Range("A" & J + 1)
xRg(K).EntireRow.Delete
'Why do we have this? We already know this is true?
'If CStr(xRg(K).Value) = MyName Then
K = K - 1
'End If
'Move count to AFTER we've actually moved the row, with On Error Resume Next your count could've gone up without a row being moved...
count = count + 1
J = J + 1
End If
Next
Application.ScreenUpdating = True
MsgBox count & " rows moved"
Handler:
If Err.Number = 1004 Then
MsgBox "File Does Not Exist"
End If
End Sub

Answer 2

This code uses FIND rather than looking at each row. It creates a range of all found rows as it goes and then copies the whole lot over in one hit before deleting the original values. Before ending it tells you how many it found.
This assumes that you have a textbox called fname and button called buttonDelete on a Userform.
Private Sub buttonDelete_Click()
Dim wrkBk1 As Workbook
Dim wrkBk2 As Workbook
Dim sPath As String
Dim wrkSht1 As Worksheet
Dim wrkSht2 As Worksheet
Dim rLastCell_Cur As Range
Dim rLastCell_Can As Range
Dim sNameToSearch As String
Dim rSearchRange As Range
Dim rFound As Range
Dim sFirstAddress As String
Dim lFoundCount As Long
Dim rFoundUnion As Range
sPath = "C:\Users\Nathan\Desktop\Sandbox\"
If Not (FileExists(sPath & "testMacro.xlsm") And FileExists(sPath & "testMacro2.xlsm")) Then
'One of the files doesn't exist so display message and exit.
MsgBox "One of the files does not exist.", vbOKOnly + vbCritical
Else
Set wrkBk1 = Workbooks.Open(sPath & "testMacro.xlsm")
Set wrkBk2 = Workbooks.Open(sPath & "testMacro2.xlsm")
If Not (WorkSheetExists("Current Customers", wrkBk1) And _
WorkSheetExists("Cancelled Services", wrkBk2)) Then
'One of the sheets doesn't exist so display message and exit.
MsgBox "One of the required sheets doesn't exist.", vbOKOnly + vbCritical
Else
'Find the limits of the two sheets.
Set wrkSht1 = wrkBk1.Worksheets("Current Customers")
Set rLastCell_Cur = LastCell(wrkSht1)
Set wrkSht2 = wrkBk2.Worksheets("Cancelled Services")
Set rLastCell_Can = LastCell(wrkSht2).Offset(1) 'We want the cell below the last cell here.
'Grab what we're searching for and where we're searching for it.
sNameToSearch = Me.fName
With wrkSht1
Set rSearchRange = .Range(.Cells(1, 1), .Cells(rLastCell_Cur.Row, 1))
End With
With rSearchRange
'Perform first search.
Set rFound = .Find(What:=sNameToSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'If something was found then we're good to go.
If Not rFound Is Nothing Then
sFirstAddress = rFound.Address
Do
lFoundCount = lFoundCount + 1
'Create a union of ranges to copy over.
If rFoundUnion Is Nothing Then
Set rFoundUnion = rFound.EntireRow
Else
Set rFoundUnion = Union(rFoundUnion, rFound.EntireRow)
End If
'Look for the next item.
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFirstAddress
'All instances have been found so copy it all over and then delete the original.
rFoundUnion.Copy wrkSht2.Cells(rLastCell_Can.Row, 1)
rFoundUnion.Delete Shift:=xlUp
End If
MsgBox "Found " & lFoundCount & " occurrences of " & sNameToSearch, vbOKOnly + vbInformation
End With
End If
End If
End Sub
Public Function FileExists(FilePath As String) As Boolean
FileExists = Dir(FilePath) <> ""
End Function
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range
Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht
If Col = 0 Then
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
Else
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
End If
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End With
On Error GoTo 0
End Function
This update to the buttonDelete_Click() procedure will open all Excel files within a specific folder and copy the found name to another file that isn't in that folder.
Private Sub buttonDelete_Click()
Dim colFiles As Collection
Dim vFile As Variant
Dim sTemp As String
Dim wrkBk1 As Workbook
Dim wrkBk2 As Workbook
Dim sPath As String
Dim wrkSht1 As Worksheet
Dim wrkSht2 As Worksheet
Dim rLastCell_Cur As Range
Dim rLastCell_Can As Range
Dim sNameToSearch As String
Dim rSearchRange As Range
Dim rFound As Range
Dim sFirstAddress As String
Dim lFoundCount As Long
Dim rFoundUnion As Range
sPath = "C:\Users\Nathan\Desktop\Sandbox\"
'Put the full path of each Excel file in to a collection.
'These contain the "Current Customers" sheet.
Set colFiles = New Collection
sTemp = Dir$(sPath & "*.xls*")
Do While Len(sTemp) > 0
colFiles.Add sPath & sTemp
sTemp = Dir$
Loop
If Not (FileExists("C:\Users\Nathan\Desktop\Cancelled.xlsx")) Then
'Cancelled Services book doesn't exist.
MsgBox "Cancelled Services doesn't exist.", vbOKOnly + vbCritical
Else
'Open Cancelled Services before working through the collection of Current Customers.
Set wrkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Cancelled.xlsx")
Set wrkSht2 = wrkBk2.Worksheets("Cancelled Services")
For Each vFile In colFiles
Set wrkBk1 = Workbooks.Open(vFile)
'The file will only be processed if it contains "Current Customers" sheet.
If WorkSheetExists("Current Customers", wrkBk1) Then
Set wrkSht1 = wrkBk1.Worksheets("Current Customers")
Set rLastCell_Can = LastCell(wrkSht2).Offset(1)
Set rLastCell_Cur = LastCell(wrkSht1)
'Grab what we're searching for and where we're searching for it.
sNameToSearch = Me.fName
With wrkSht1
Set rSearchRange = .Range(.Cells(1, 1), .Cells(rLastCell_Cur.Row, 1))
End With
With rSearchRange
'Perform first search.
Set rFound = .Find(What:=sNameToSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'If something was found then we're good to go.
If Not rFound Is Nothing Then
sFirstAddress = rFound.Address
Do
lFoundCount = lFoundCount + 1
'Create a union of ranges to copy over.
If rFoundUnion Is Nothing Then
Set rFoundUnion = rFound.EntireRow
Else
Set rFoundUnion = Union(rFoundUnion, rFound.EntireRow)
End If
'Look for the next item.
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFirstAddress
'All instances have been found so copy it all over and then delete the original.
rFoundUnion.Copy wrkSht2.Cells(rLastCell_Can.Row, 1)
rFoundUnion.Delete Shift:=xlUp
End If
End With
End If
Set rFound = Nothing
Set rFoundUnion = Nothing
sFirstAddress = ""
wrkBk1.Close SaveChanges:=True
Next vFile
MsgBox "Found " & lFoundCount & " occurrences of " & sNameToSearch, vbOKOnly + vbInformation
End If
End Sub

Answer 3

To answer the first question about checking if a sheet exist in a workbook, you can use a Function like this:
Public Function U_W_DoesWorksheetExist(ByVal sheetname As String, aWorkbook As Workbook) As Boolean
On Error Resume Next
U_W_DoesWorksheetExist = (Not aWorkbook.Sheets(sheetname) Is Nothing)
On Error GoTo 0
End Function
Now, when you reference the destination, you are saying just Worksheets("Cancelled Services") and the Macro will assume the ActiveWorkook as the main workbook where to copy the Sheet. You need to reference the Workbook where the sheet you are pasting is located. See if the code below works for you and take a look at the comments I added on it:
Private Sub buttonDelete_Click()
'When the Delete button is clicked, the following function is ran to copy the row from Current Services, move it to Cancelled Services
'and then delete the row from Current Services.
Dim wkBk1 As Workbook
Dim wkBk2 As Workbook
Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
Dim count As Long
Dim arrFromWorkbookPath(1 To 4) As String
Dim c As Long
' If you need more than 4 rearrange the Array to as many as you need.
arrFromWorkbookPath(1) = "C:\Users\Nathan\Desktop\Sandbox\FromWB1.xlsm"
arrFromWorkbookPath(4) = "C:\Users\Nathan\Desktop\Sandbox\FromWB2.xlsm"
arrFromWorkbookPath(3) = "C:\Users\Nathan\Desktop\Sandbox\FromWB3.xlsm"
arrFromWorkbookPath(4) = "C:\Users\Nathan\Desktop\Sandbox\FromWB4.xlsm"
' The Workbook were you will be pasting the sheets.
Set wkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro2.xlsm")
For c = LBound(arrFromWorkbookPath) To UBound(arrFromWorkbookPath)
On Error Resume Next
' Open the Workbook from where the sheet will be copied from.
Set wkBk1 = Workbooks.Open(arrFromWorkbookPath(c))
If Err.Number = 1004 Then
MsgBox "File Does Not Exist"
Exit Sub
End If
' USE PROCEDURE LIKE THIS TO CHECK "Current Customers" in wkBk1 and Cancelled Services in wkBk2.
If U_W_DoesWorksheetExist("Current Customers", wkBk1) And U_W_DoesWorksheetExist("Cancelled Services", wkBk1) Then
i = wkBk1.Worksheets("Current Customers").UsedRange.Rows.count
J = wkBk2.Worksheets("Cancelled Services").UsedRange.Rows.count
count = 0
If J = 1 Then
If Application.WorksheetFunction.CountA(wkBk2.Worksheets("Cancelled Services").UsedRange) = 0 Then J = 0
End If
Set xRg = wkBk1.Worksheets("Current Customers").Range("A1:A" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.count
If CStr(xRg(K).Value) = Me.fName.Value Then
count = count + 1
' Here you need to specify the workbook, not just the sheet wkBk2.Worksheets("Cancelled Services").
xRg(K).EntireRow.Copy Destination:=wkBk2.Worksheets("Cancelled Services").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = Me.fName.Value Then
K = K - 1
End If
J = J + 1
End If
Next
wkBk1.Close False
Else
' Display error if the sheet doesn't exist.
MsgBox "Sheets Current Customers or Cancelled Services don't exists."
End If
Next c
Application.ScreenUpdating = True
End Sub