Finding and moving data between worksheets based on dynamic variables

[Talfryn]

Greetings,

Been scratching my head over this, and while I've found many examples of code which copy and paste data between worksheets, I'm struggling to adapt it to what I want it to do. The last time I did any real VBA coding was in college about 17 years ago so I'm kinda jumping in the deep end here and while I can understand small snippets, most of the code I've looked at over the past few days is going over my head.

So far, I have vlookups in the cells to the left and right of F3 which return data on the serial number entered into F3. Right now we can see the s/n 1234ABCD is located on the sheet "In", has a part number of "AB", a status of "Bad" etc.

In essence, what I'd like to have is a button that will move that serial number and its corresponding data into a different sheet based on a drop-down list that will be in H7. For example, if H7 contains "WIP" the button will move that row of data into "WIP" and delete it from "In"

Here are screenshots of the "Main" sheet where I want the button and the "In" sheet where the data is located.

Any help with this would be much appreciated.

 

[OaklandJim]

This should be doable. I'll give it a try.

Pictures are not very helpful. Ideally you post a link to your workbook. You can enter fake-but-realistic data before providing the link. Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the message area. Make sure that other people can access the file!

If not, share relevant data using Mr Excel's excellent XL2BB addin that enables you to post a portion of a worksheet. See XL2BB - Excel Range to BBCode for details.

I expect that you'll need a VBA solution that does what is required but I am not certain.

The worst case is that you'll need a VBA solution that does what is needed, if worksheet formulas do not work.

 

[Talfryn]

Thank you so much for taking a look at this. Here is a OneDrive link to the spreadsheet, hopefully you can open it.

Mezz2.xlsm

Not sure if it contains all the VBA modules as well. If not, let me know if you want me to share any code, though I'm not sure how helpful it'll be as it is a complete mess of half completed code mish-mashed together from other sites.

 

[Talfryn]

So I've been digging around a bit more and found this bit of code from Joe Was in another thread on this forum. It does an excellent job at finding the serial number on the Main sheet and returning the worksheet it's located in along with the cell number. It's probably a bit more complex than what I need it for but it works, and returning the sheet and cell number as values could be useful later down the line.

My issue now is getting it move the row of data from the sheet it's found in to the sheet that's listed in cell H7 on the Main sheet. If I un-comment the two lines where it copies the row, it copies it into the destination sheet twice (and ideally needs to remove it from the original sheet as well), but more importantly I need it to be able to move the data to the sheet listed in H7 as mentioned before, at the moment I've just defined the destination sheet manually to check it copies the data correctly.

Option Explicit

Sub Findvalue()

Dim serialnumber As String
Dim ws As Worksheet
Dim Found As Range
Dim FirstAddress As String
Dim AddressStr As String
Dim foundNum As Integer

serialnumber = Range("F3")


If serialnumber = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
    If ws.Name = "Main" Then GoTo myNext
            
        Set Found = .UsedRange.Find(what:=serialnumber, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
                
        If Not Found Is Nothing Then
            FirstAddress = Found.Address
                        
            Do
                foundNum = foundNum + 1
                AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
                            
                Set Found = .UsedRange.FindNext(Found)
                            
                'Copy to destination sheet
                Found.EntireRow.Copy _
                Destination:=Worksheets("Scrap").Range("A65536").End(xlUp).Offset(1, 0) 'Destination sheet needs to be based on cell H7
            Loop While Not Found Is Nothing And Found.Address <> FirstAddress
        End If
myNext:
End With

Next ws

If Len(AddressStr) Then
    MsgBox "Found: """ & serialnumber & """ " & foundNum & " times." & vbCr & _
    AddressStr, vbOKOnly, serialnumber & " found in these cells"
Else:
    MsgBox "Unable to find " & serialnumber & " in this workbook.", vbExclamation
End If
                
'MsgBox serialnumber

End Sub

 

[OaklandJim]

I'll give this a whirl. It should be straightforward.

 

[OaklandJim]

Regarding "serial number entered into F3"...is the list of serial numbers that user may enter into F3 S/Ns from all worksheets? It seems that the list of S/Ns that user may enter contains all S/Ns from all worksheets: In, WIP, Bad and Good. Will there be other worksheets? If so what are their names?

Regarding sheet names...I'm interested to know if there will be other worksheets that do NOT contain a table of S/Ns in their data?

I need you to reconcile data elements that differ among sheets. Examples: In has No. in the first column and the other sheets have Tesseract/TopDesk in the first column. The In worksheet's fourth column is Status but WIP and Bad have Fault in the corresponding column.

 

[OaklandJim]

Here are columns in each worksheet.

Worksheet In: No. S/N P/N Status Loc Notes Date
Worksheet WIP: Tesseract/TopDesk S/N P/N Fault Loc Notes Date
Worksheet Bad: Tesseract/TopDesk S/N P/N Fault Loc Notes Date
Worksheet Good: Tesseract/TopDesk S/N P/N Status Loc Notes Date

 

[Talfryn]

Yes, all the worksheets (apart from Main) will contain serial numbers. The Main worksheet is where a user will enter a number in F3 to quickly retrieve data on that number (e.g. status, date booked in, location on the shelf etc). There may be other worksheets added later down the line but I'm sure I can add those into the code myself if I need to.

I will adjust the header names so they are consistent across the sheets so it would be more along the lines of:

Worksheet In: Ref.No. S/N P/N Status Loc Notes Date
Worksheet WIP: Ref.No. S/N P/N Status Loc Notes Date
Worksheet Bad: Ref.No. S/N P/N Status Loc Notes Date
Worksheet Good: Ref.No. S/N P/N Status Loc Notes Date

More columns may be added later down the line, but again I'm sure I can add them into the code if I need to.

 

[OaklandJim]

Here is what I have. When moving data the VLOOKUP was causing errors. So I added code for a Function that does the lookup. It works well. Unless there are thousands of S/Ns it should not bog down calculation too much. I also added a sub that gathers all S/Ns and puts them into a dropdown in cell F3. If there are too many S/Ns for a dropdown let me know and I'll remove that functionality and then you can enter the S/N directly as before. There is also a sub that puts a dropdown with all worksheets except the main worksheet -- and excepting other worksheets specified in the new worksheet called control -- into H7. Finally, there is code to do the move after clicking a button.

There are a few important notes.

As mentioned above, I added a worksheet named Control. It includes a list of worksheets that do not have serial number data and that should be excluded when compiling the list of serial numbers. It also has the list of serial numbers that fill the dropdown for serial numbers in worksheet Main, cell F3.

Regarding the serial numbers, code always starts in cell B1 in the respective data worksheet to locate serial numbers. If that changes you'll have to modify code.

I named the cell containing the serial number dropdown to Input_Serial_Number. Code uses that name to know where to put the dropdown. Similarly, I added name Input_Worksheet_Name for the cell where the "move to" worksheet name is specified using the dropdown.

Oddly, the commands in the code that add the dropdown for serial numbers and for worksheets causes an error intermittently. I cannot figure out why. So code is set to not execute that command -- with a message -- if there IS an error. This is not totally satisfying but the code seems to work as expected 95% of the time. If there is no dropdown for serial numbers or worksheets you can still input them.

I used what is called an Event. In Excel an event is code that is triggered when a specific condition is met. In this case I used the Worksheet_Activate event for worksheet Main. The event puts the dropdown for serial numbers and for worksheets into worksheet Main each time that the worksheet Main is activated (by selecting its tab). That code is located in the code module for Main.

It seems likely that there will be issues. Please contact me if there ARE issues.

Here is the workbook.

' ----------------------------------------------------------------
' Procedure Name: FindSNInSheets
' Purpose: Find the serial number or corresponding data item in worksheets.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psStockNumber (String): The serial number to locate.
' Parameter piColumn (Long): The column -- if any -- in which the corresponding data is located.
' Return Type: String
' Author: Jim
' Date: 7/29/2023
' ----------------------------------------------------------------

Function FindSNInSheets(psStockNumber As String, Optional piColumn As Long = 0) As String

    Dim wsLoop As Worksheet

    Dim rFoundCell As Range
    
    Dim iOffset As Long

'   Array holding names of worksheets to exclude from list of workshets to look in
'   when searching for the serial number.
    Dim asSheetsToExclude()

'   Count of worksheets to exclude from the list of worksheets to look in
'   when searching for the serial number.
    Dim iWorksheetsToExcludeCount As Long

    Dim bDoExcludeSheet As Boolean

    Dim iWorksheetIndex

'   How many worksheets are there to exclude from the list of worksheets to look in
'   when searching for the serial number.
    iWorksheetsToExcludeCount = 10
    
'   Size the array holding names of worksheets to exclude from the list of worksheets
'   to look in when searching for the serial number.
    ReDim asSheetsToExclude(iWorksheetsToExcludeCount)

'   Put names of worksheets to exclude into the array. Increase the number in variable
'   iWorksheetsToExcludeCount before adding more name(s).
'   Size the array holding names of worksheets to exclude from the list of worksheets
'   to process when moving a serial number's data.
    ReDim asSheetsToExclude(10)

'   Put names of worksheets to exclude into the asSheetsToExclude array.
    With Worksheets("Control").Range("WorksheetsToExclude")
        asSheetsToExclude(1) = .Cells(1).Value
        asSheetsToExclude(2) = .Cells(2).Value
        asSheetsToExclude(3) = .Cells(3).Value
        asSheetsToExclude(4) = .Cells(4).Value
        asSheetsToExclude(5) = .Cells(5).Value
        asSheetsToExclude(6) = .Cells(6).Value
        asSheetsToExclude(7) = .Cells(7).Value
        asSheetsToExclude(8) = .Cells(8).Value
        asSheetsToExclude(9) = .Cells(9).Value
        asSheetsToExclude(10) = .Cells(10).Value
    End With

'   Default return value -- if the serial number is not found.
    FindSNInSheets = "?"
    
    For Each wsLoop In ThisWorkbook.Worksheets

'       Determine if the current worksheet being processed is to be excluded
'       from the list of worksheets to look in when specifying the worksheet
'       to transfer data for a serial number from.
        bDoExcludeSheet = False
'
        For iWorksheetIndex = 1 To UBound(asSheetsToExclude)

            If wsLoop.Name = asSheetsToExclude(iWorksheetIndex) _
             Then
                bDoExcludeSheet = True
                Exit For
            End If

        Next iWorksheetIndex

'       If the worksheet wsLoop is not a worksheet to exclude then look in it for the serial number.
        If Not bDoExcludeSheet _
         Then

'           Search for (Find) the serial number in worksheet wsLoop.
            With wsLoop.UsedRange
                Set rFoundCell = .Find(What:=psStockNumber, _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
            End With

'           If the serial number was found (cell rFoundCell is Not Nothing) then
'           the range object named rFoundCell points to the cell containing the
'           serial number.
            If Not rFoundCell Is Nothing _
             Then

'               If lookup column IS NOT specified (parameter piColumn = 0) then
'               merely return the worksheet name where the serial number is found.
                If piColumn = 0 _
                 Then
                    FindSNInSheets = wsLoop.Name
                    
'               If a lookup column IS specified (parameter piColumn <> 0) then
'               return the value corresponding to the serial number (from the column
'               in the worksheet where the serial number is found).
                Else
                    
'
                    If piColumn = rFoundCell.Column _
                     Then
                        FindSNInSheets = wsLoop.Name
                        Exit For
                     
                    ElseIf piColumn < rFoundCell.Column _
                     Then
                        iOffset = rFoundCell.Column - piColumn
                    Else
                        iOffset = piColumn - rFoundCell.Column
                    End If

                    FindSNInSheets = rFoundCell.Offset(0, iOffset)

                End If

'               Exit the For Loop iterating through all worksheets.
                Exit For

            End If 'Not rFoundCell Is Nothing

        End If 'Not bDoExcludeSheet

    Next wsLoop

End Function

Option Explicit
Option Base 1

' ----------------------------------------------------------------------------------
' Procedure Name: CreateSerialNumberDropDown
' Purpose: Put a dropdown with worksheet names into specified cell in worksheet Main
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 7/28/2023
' -----------------------------------------------------------------------------------

Sub CreateSerialNumberDropDown()

'   Worksheet object that points to the worksheet main
    Dim wsMain As Worksheet
    
'   Worksheet object used to loop through all worksheets to get
'   serial numbers.
    Dim wsLoop As Worksheet
    
'   Object for the header cell for all S/N data in the respective
'   worksheet (being processed).
    Dim rSerialNumsHeaderCell As Range

'   Object for the cell with dropdown containing the S/N data
    Dim rSerialNumsDropDownCell As Range
    
'   The current Serial Number being processed.
    Dim sSerialNumber As String
    
'   This array holds the names of all worksheets in the workskbook to be processed.
    Dim avSheetNames() As Variant
    
'   Used to keep track of how many to be processed worksheets to process.
    Dim iWorksheetsToProcess As Long
        
'   Used to keep track of how many worksheets have been processed.
    Dim iWorksheetsProcessed

'   Cell below which the list of serial numbers is located'
    Dim rSerialNumbersAnchorCell As Range
    
'   Used to keep track of the number of serial numbers processed in all worksheets.
    Dim iSerialNumbersTotal As Long
    
'   Used to keep track of the number of serial numbers processed for one worksheet.
    Dim iSerialNumberLoopIndex As Long
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'   Set worksheet object to point to the Main worksheet.
    Set wsMain = Worksheets("Main")
    
'   Cell where Serial Numbers dropdown list is to be located.
    Set rSerialNumsDropDownCell = wsMain.Range("Input_Serial_Number") '<= cell in Main worksheet where dropdown
'                                                                         list of serial numbers is to be placed.

'   Call the sub that gets the current list of worksheets to be included in the
'   search for serial numbers. Variable array parameter avSheetNames is returned
'   with content that includes the worksheet names to look in for serial numbers.
    Call CreateWorksheetsList(avSheetNames())
    
'   Get the count of worksheets to process (iWorksheetsToProcess) from the upper bound
'   of the array holding worksheet names. That Ubound is the count of entries in the array.
    iWorksheetsToProcess = UBound(avSheetNames)
    
'   Set up the range in the Control worksheet where the serial numbers are stored/listed.
    Set rSerialNumbersAnchorCell = Worksheets("Control").Range("E3")      'Point the anchor cell to cell E3
    rSerialNumbersAnchorCell.EntireColumn.Value = ""                      'Clear values.
    rSerialNumbersAnchorCell.Value = "Serial Numbers"                     'Add header.
        
'   Initialize the count of all serial numbers processed.
    iSerialNumbersTotal = 0

'   Iterate through all worksheets to process.
    For iWorksheetsProcessed = 1 To iWorksheetsToProcess
        
'       Set wsLoop object to point to the worksheet being processed in the current iteration.
        Set wsLoop = ThisWorkbook.Worksheets(avSheetNames(iWorksheetsProcessed))
        
'       Point rSerialNumsHeaderCell range object to the "header" cell in worksheet
'       that is currently being processed.
        Set rSerialNumsHeaderCell = wsLoop.Range("B1") '<= If the column where serial numbers are located in the
'                                                          data worksheets changes then change this accordingly.
        
'       Initialize the count of serial numbers processed for the worksheet that is
'       currently being processed.
        iSerialNumberLoopIndex = 0
        
        With rSerialNumsHeaderCell
            
'           Iterate through the cells in the worksheet that is currently being processed
'           which contain seiral numbers until the next cell is empty.
            Do
'               Increment count of cells processed in the worksheet being processed.
                iSerialNumberLoopIndex = iSerialNumberLoopIndex + 1
                
'               Increment count of all serial numbers being processed, in all worksheets.
                iSerialNumbersTotal = iSerialNumbersTotal + 1
                        
'               Put the serial number intothe next cell in the range in the Control
'               worksheet that contains hte list of all serial numbers.
                rSerialNumbersAnchorCell.Offset(iSerialNumbersTotal).Value = .Offset(iSerialNumberLoopIndex).Value
                
            Loop Until .Offset(iSerialNumberLoopIndex + 1) = ""
        
        End With

'   Process the next worksheet containing serial numbers.
    Next iWorksheetsProcessed
    
'   Add the workbook scoped range name pointing to the range containing the serial numbers list
'   in the Control worksheet.
    With ThisWorkbook

        .Names("SerialNumbersList").Delete
        
        .Names.Add _
            Name:="SerialNumbersList", _
            RefersTo:="=Control!" & rSerialNumbersAnchorCell.Offset(1).Resize(iSerialNumbersTotal).Address
    
    End With

'   Set up the dropdown list of serial numbers. It goes into cell rSerialNumsDropDownCell. The
'   list is in the range named SerialNumbersList in the worksheet control.

'   Oddly, this causes an error intermittently. So it is set to not execute if there is
'   an error. Not totally satisfying but it seems to work 95% of the time. If there is
'   no dropdown for serial numbers you can still input the serial number manually.

'   NOTE: This sub is triggered each time that the Main worksheet is activated.
    
    On Error GoTo DropDownError
    
    With rSerialNumsDropDownCell.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=SerialNumbersList"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    On Error GoTo 0
    
'   Sort the serial numbers for the validation dropdown.
    With ThisWorkbook.Worksheets("Control")
        .Activate
        .Sort.SortFields.Clear
        .Range("SerialNumbersList").Sort Key1:=.Range("SerialNumbersList").Cells(1), Order1:=xlAscending, Header:=xlNo
        .Range("SerialNumbersList").Offset(-1).Cells(1).Activate
    End With
    
    wsMain.Activate

Cloesout:

    Application.EnableEvents = True
    
    Set wsMain = Nothing
    Set wsLoop = Nothing
    Set rSerialNumsDropDownCell = Nothing
    Set rSerialNumsHeaderCell = Nothing

Exit Sub

DropDownError:

    Dim sMsg As String
    
    sMsg = "There was an error adding the serial numbers" _
           & Chr(10) _
           & "dropdown to worksheet Main. Try deactivating" _
           & Chr(10) _
           & "then reactivating worksheet Main."
         
    MsgBox sMsg, vbExclamation

End Sub

Option Explicit
Option Base 1

' -------------------------------------------------------------------------
' Procedure Name: Sub CreateWorksheetsList
' Purpose: Put a dropdown with worksheet names into specified cell in Main.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 7/28/2023
' -------------------------------------------------------------------------

Sub CreateWorksheetsList(Optional pavLookinSheets As Variant)
    
'   Worksheeet object for the main worksheet.
    Dim wsMain As Worksheet
    
'   Single celled range object for cell into which the dropdown list will be placed.
    Dim rDropdownCell As Range
    
'   Worksheet object used to loop through the worksheets collection.
    Dim wsLoop As Worksheet
    
'   String variable holding list of sheets in dropdown list.
    Dim sDropDownEntriesList As String
    
'   Used to keep track of count of worksheets found.
    Dim iWorksheetsCount As Long
    
'   Array holding names of worksheets to exclude from list of workshets to look in
'   when searching for the serial number.
    Dim asSheetsToExclude()
    
'   Count of worksheets to exclude from the list of worksheets to look in
'   when searching for the serial number.
    Dim iWorksheetsToExcludeCount As Long
    
'   Boolean flag indicting whether a worksheet is to be excluded from the list of
'   worksheets to specify when transferring the serial number's data to another worksheet.
    Dim bDoExcludeSheet As Boolean
    
'   Used to look for worksheets to exclude from list of worksheets from which to move data.
    Dim iWorksheetIndex As Long
    
'   Used when excluding worksheets from the list of worksheets that user sees
'   when selecting a worksheet to transfer serial number's data to another worksheet.
    Dim sWorksheetName As String
    

'   Set worksheet object to point to the worksheet main.
    Set wsMain = ThisWorkbook.Worksheets("Main")
    
'   Set range objects to point to 1. cell for dropdown list of worksheet names
'   and 2. the first ccell in the range named "Lookup_Sheets".
    
    Set rDropdownCell = wsMain.Range("Input_Worksheet_Name") '<= change this if the location of the
'                                                                dropdown for worksheets is moved.

'   Size the array holding names of worksheets to exclude from the list of worksheets
'   to process when moving a serial number's data.
    ReDim asSheetsToExclude(10)

'   Put names of worksheets to exclude into the asSheetsToExclude array.
'   Those worksheet names are located in the Control worksheet.
    With Worksheets("Control").Range("WorksheetsToExclude")
        asSheetsToExclude(1) = .Cells(1).Value
        asSheetsToExclude(2) = .Cells(2).Value
        asSheetsToExclude(3) = .Cells(3).Value
        asSheetsToExclude(4) = .Cells(4).Value
        asSheetsToExclude(5) = .Cells(5).Value
        asSheetsToExclude(6) = .Cells(6).Value
        asSheetsToExclude(7) = .Cells(7).Value
        asSheetsToExclude(8) = .Cells(8).Value
        asSheetsToExclude(9) = .Cells(9).Value
        asSheetsToExclude(10) = .Cells(10).Value
    End With

'   --------------------------------------------
'       Gather list of Worksheets to Include
'   --------------------------------------------
   
    For Each wsLoop In ThisWorkbook.Worksheets

'       Determine if the current worksheet being processed is to be excluded
'       from the list of worksheets to look in when specifying the worksheet
'       to transfer data for a serial number from.
        bDoExcludeSheet = False
        
'       Iterate through all worksheet names in array asSheetsToExclude to determine
'       if the worksheet currently being processed should be excluded from those from
'       which worksheet names will be added to the list of worksheet.
        For iWorksheetIndex = 1 To UBound(asSheetsToExclude)

            If wsLoop.Name = asSheetsToExclude(iWorksheetIndex) _
             Then
                bDoExcludeSheet = True
                Exit For
            End If
        
        Next iWorksheetIndex
        
'       If the worksheet is not one that is to be excluded then add it to the list
'       of worksheets for the dropdown.
        If Not bDoExcludeSheet _
         Then
            If sDropDownEntriesList <> "" Then sDropDownEntriesList = sDropDownEntriesList & ","

            sDropDownEntriesList = sDropDownEntriesList & wsLoop.Name
            
'           Increment the count of worksheets added to the list.
            iWorksheetsCount = iWorksheetsCount + 1
            
'           Handle optional parameter: an array holding names of
'           worksheets that contain serial number data.

'           If caller passed that parameter to this sub then
'           update it with the name of the worksheet currently
'           being processed.

            If Not IsMissing(pavLookinSheets) _
             Then
                ReDim Preserve pavLookinSheets(iWorksheetsCount)
                pavLookinSheets(iWorksheetsCount) = wsLoop.Name
            End If

        End If

    Next wsLoop

'   --------------------------------------------
'         Fill Workheets List Dropdown
'   --------------------------------------------
   
'   Put the dropdown containing worksheet names into the specified cell (rDropdownCell).
    
'   Oddly, this causes an error intermittently. So it is set to not execute if there is
'   an error. Not totally satisfying but it seems to work 95% of the time. If there is
'   no dropdown for worksheets you can still input the worksheet name manually.

'   NOTE: This sub is triggered each time that the Main worksheet is activated.
    
    On Error GoTo DropDownError
    
    With rDropdownCell.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=sDropDownEntriesList
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    On Error GoTo 0

Closeout:
    
    Set wsLoop = Nothing
    Set wsMain = Nothing
    Set rDropdownCell = Nothing

Exit Sub

DropDownError:

    Dim sMsg As String
    
    sMsg = "There was an error adding the worksheets" _
           & Chr(10) _
           & "dropdown to worksheet Main. Try deactivating" _
           & Chr(10) _
           & "then reactivating worksheet Main."
         
    MsgBox sMsg, vbExclamation

End Sub

Option Explicit

' ------------------------------------------------------------------------------------------
' Procedure Name: MoveSerialNumberData
' Purpose: Move serial number from specified source worksheet to specified target worksheet.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 7/29/2023
' ------------------------------------------------------------------------------------------

Sub MoveSerialNumberData()

'   Wortksheet object that points to the worksheet named Main.
    Dim wsMain As Worksheet
    
'   Wortksheet object that points to the worksheet to move data from.
    Dim wsSource As Worksheet

'   Wortksheet object that points to the worksheet into which the data is transferred.
    Dim wsTarget As Worksheet

'   Cell containing serial number in worksheet named Main.
    Dim rSerialNumberCell As Range
    
'   "Lookup" cell containing name of worksheet that contains the S/N to be moved.
    Dim rWorksheetFromNameCell As Range
    
'   Cell containing name of worksheet to transfer the S/N to.
    Dim rWorksheetToNameCell As Range
    
'   The cell where the serial number was found in the source worksheet.
    Dim rSerialNumberFoundCell As Range
    
'   Location (upperleftmost cell) where the data is to be pasted.
    Dim rTargetCell As Range

'   Row number of the data to move to the Source worksheet.
    Dim iMoveFromRowNum As Integer
    
'   Row number of the data to move to in the Target worksheet.
    Dim iMoveToRowNum As Integer
    
'   Count of rows that need to be moved up after the deletion.
    Dim iMoveRowsCount As Integer
    
'   Serial Number whose data is to be moved.
    Dim sSerialNumberToMove As String
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'   ------------------------------------
'       Set Main Worksheet and Ranges
'   ------------------------------------

    Set wsMain = ThisWorkbook.Worksheets("Main")
    
    With wsMain
        
'       Set range object to point to the cell in worksheet Main that contains the serial number.
        Set rSerialNumberCell = .Range("F3")

'       Set range object to point to the cell in worksheet Main that contains the serial number.
        Set rWorksheetToNameCell = .Range("H7")
        
        Set rWorksheetFromNameCell = .Range("G3")
    
    End With
    
'   ------------------------------------
'          Serial Number to Move
'   ------------------------------------

'   If the cell that should contain a serial number is empty then tell user and exit sub.
    If rSerialNumberCell.Value = "" _
     Then
        MsgBox "You must specify a serial number.", vbExclamation
        Exit Sub
    End If
    
'   Get serial number to move from the Main worksheet cell.
    sSerialNumberToMove = rSerialNumberCell.Value
    
'   ------------------------------------
'           Set Source Worksheet
'   ------------------------------------
    
'   Set the source worksheet (object). That is the worksheet to transfer data FROM.
    On Error Resume Next
    Set wsSource = ThisWorkbook.Worksheets(rWorksheetFromNameCell.Value)
    On Error GoTo 0
    
'   If the source worksheet specified cannot be found then tell user and exit sub.
    If wsSource Is Nothing _
     Then
        MsgBox "The worksheet named " & rWorksheetToNameCell.Value & " does not exist.", vbExclamation
        Exit Sub
    End If
    
'   ------------------------------------
'           Set Target Worksheet
'   ------------------------------------

'   Set the target worksheet (object). That is the worksheet to transfer data TO.
    On Error Resume Next
    Set wsTarget = ThisWorkbook.Worksheets(rWorksheetToNameCell.Value)
    On Error GoTo 0
    
'   If the target worksheet specified cannot be found then tell user and exit sub.
    If wsTarget Is Nothing _
     Then
        MsgBox "The worksheet named " & rWorksheetToNameCell.Value & " does not exist.", vbExclamation
        Exit Sub
    End If
    
'   ------------------------------------------------
'      Source and Target Worksheets are the Same
'   ------------------------------------------------

'   Handle source worksheet and target worksheet are the same.
    If wsSource.Name = wsTarget.Name _
     Then
        MsgBox "The source worksheet and the target worksheet are the same.", vbExclamation
        Exit Sub
    End If
    
'   ----------------------------------------------
'       Find Serial Number in Source Worksheet
'   ----------------------------------------------
        
'   Locate (Find) the cell containing the serial number to move in the source workbook.
    Set rSerialNumberFoundCell = wsSource.UsedRange.Find(sSerialNumberToMove)
    
    If rSerialNumberFoundCell Is Nothing _
     Then
        MsgBox "The serial number " & sSerialNumberToMove & Chr(10) _
               & "in worksheet named " & wsSource.Name, vbExclamation
        Exit Sub
        
    End If
    
'   Row number to move data from in the Source worksheet.
    iMoveFromRowNum = rSerialNumberFoundCell.Row
    
'   Get the next empty row in the target worksheet into which to put the
'   transferred data.
    iMoveToRowNum = wsTarget.Range("A" & Rows.Count).End(xlUp).Row + 1

'   -------------------------------------------------
'       Move Data from Source Worksheet to Target
'   -------------------------------------------------

'   Cut from the row in source worksheet and paste into the target worksheet
'   next available row.
    With rSerialNumberFoundCell.EntireRow
        .Cut wsTarget.Rows(iMoveToRowNum & ":" & iMoveToRowNum)
    End With

'   Delete the row where data was transferred from in Source worksheet.
    wsSource.Rows(iMoveFromRowNum & ":" & iMoveFromRowNum).Delete Shift:=xlUp

Closeout:

    With wsTarget
        .Activate
        .Cells(1).Activate
    End With
    
    wsMain.Activate
    
    rSerialNumberCell.Value = ""

    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set rWorksheetToNameCell = Nothing
    Set rWorksheetFromNameCell = Nothing
    
    With Application
        .EnableEvents = True
        .CalculateFull
        .EnableEvents = True
    End With
    
End Sub

 

[Talfryn]

This is incredible, thank you so much. I will update you once I've had a chance to comb through the code and have a play around with it.