Creating Macro for Moving Stock Records

PenguinLog

New Member
Joined
Nov 1, 2022
Messages
4
Office Version
  1. 365
Platform
  1. Windows
I've searched on Google and through the Mr.Excel forums, but can't quite find what I'm after.

I have equipment that is stocked in my warehouse that we need to keep better track of and reduce some of the manual processes that have been in place. The first workbook (called "P2022") and worksheet (named "WH Stock") contains the records for the equipment (simplified):

DateModelSerialSold POCustomer
11/01/2022CBA38MV1522E67098144555666Smith

The other workbook (called "Unit Inventory") and worksheet ("Inventory IN") also contains the same columns plus a few more that are relevant to that work sheet.

Once any information is entered into the "Customer" column for any row, I need to press a button that triggers two macros to:
1 -
Copy the row that contains any value in the "Customer" column in the current open workbook ("P2022") and worksheet ("WH Stock")
Open a closed workbook ("Unit Inventory")
Navigate to the correct worksheet ("Inventory IN")
Paste the row into this now open workbook/worksheet
Save the workbook
Close the workbook
Navigate back to the first workbook
2 -
Select the row with that contains any value in the "Customer" column
Hide this row

I pulled this code from the web for sheet-to-sheet copying, but I can't figure out how to add in the opening, pasting, saving, and closing of the second workbook or how to reference it:

VBA Code:
Sub MoveStock()
'Copy rows with column P filled with a Y and paste to another worksheet
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("WH Stock").UsedRange.Rows.Count
'First workbook
    J = Worksheets("Inventory IN").UsedRange.Rows.Count
'Second workbook
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Inventory IN").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("WH Stock").Range("P1:P" & I)
'Looking in the whole P column
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Y" Then
'I'd like to reference any value rather than a specific value. Previously this column was labeled as a Y/N, because I can't figure out how to add any value conditions.
            xRg(K).EntireRow.Copy Destination:=Worksheets("Inventory IN").Range("A" & J + 1)
'Copy to the second workbook/worksheet
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Then the second macro is

VBA Code:
Sub HideRows()
  Dim cell As Range
  For Each cell In ActiveWorkbook.ActiveSheet.Columns("P").Cells
      If cell.Value = "Y" Then
'Again, the P column used to contain a Y/N title, which would tell the user to enter either a Y or N, which could be referenced for the function
      cell.EntireRow.Hidden = True
    End If
  Next cell
End Sub

I can get this to run perfectly fine within on workbook, but I don't know enough about coding in VBA to add the necessary lines to copy and paste to a closed workbook.
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
I got it to work partially:

VBA Code:
Sub MoveStock()
'Copy rows with column P filled with a Y and paste to another worksheet
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Workbooks("Warehouse_Stock_TEST").Worksheets("Warehouse_STOCK").UsedRange.Rows.Count
    J = Workbooks("Test2PasteLocation").Worksheets("Sheet1").UsedRange.Rows.Count
    
    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Sheet1").UsedRange) = 0 Then J = 0
        End If
        Set xRg = Workbooks("Warehouse_Stock_TEST").Worksheets("Warehouse_STOCK").Range("P1:P" & I)
        On Error Resume Next
        Application.ScreenUpdating = False
        For K = 1 To xRg.Count
            If CStr(xRg(K).Value) = "Y" Then
                xRg(K).EntireRow.Copy Destination:=Workbooks("Test2PasteLocation").Worksheets("Sheet1").Range("A" & J + 1)
                J = J + 1
            End If
        Next
        Application.ScreenUpdating = True
    
    End Sub

This macro is triggered by another macro:

VBA Code:
Sub Finish_Work() 'Click to run both macros
    Call OpenTest2
    ThisWorkbook.Activate
    Call MoveStock 'Macro1
    Call HideRows 'Macro2
    Call CloseTest2
End Sub

This opens my pasting location, activates the workbook that the macro runs from (I think), finds the value "Y" from the range in the copying location, pastes it into the new location, hides the old row, and saves and closes the pasted location workbook.

Now, I'm finding that it's duplicating every record! It's copying every record from the Stock worksheet with the Y in column P, even the hidden rows. So I'm getting duplicates in my new workbook. Any help with this?
 
Upvote 0
After more searching, I added another macro that finds and replaces my cell value with something else. The next time the macro runs, it only copies the row with the old value, not the new one. So I don't need to add more macros to the second sheet. It's works as intended now.

My single button macro:

VBA Code:
Sub FinishWork() 'Click to run both macros
    Call OpenTest2
    Call MoveStock 'Macro1
    Call CloseTest2
    Call FindReplace
    Call HideRows

End Sub

OpenTest2 opens my pasting location:

VBA Code:
Sub OpenTest2()
'Open a workbook

  'Open method requires full file path to be referenced.
  Workbooks.Open "OpenTest2"
  

End Sub

Then I copy the rows from the original workbook:

VBA Code:
Sub MoveStock() 'Module 2
'Declare variables
    Dim DataRg As Range
    Dim DataCell As Range
    Dim P As Long
    Dim J As Long
    Dim I As Long
'Set variables
    P = Workbooks("Warehouse_Stock_TEST").Worksheets("Warehouse_STOCK").UsedRange.Rows.Count
    Q = Workbooks("Test2PasteLocation").Worksheets("Sheet1").UsedRange.Rows.Count
''Type If condition to relate the variables I and Q
    If I = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet1").UsedRange) = 0 Then Q = 0
    End If
'Set range for Dataset1
    Set DataRg = Workbooks("Warehouse_Stock_TEST").Worksheets("Warehouse_STOCK").Range("P1:P" & P)
    On Error Resume Next
    Application.ScreenUpdating = False
'Apply the For loop
    For I = 1 To DataRg.Count
'Set Condition for "Move" value
        If CStr(DataRg(I).Value) = "Yes" Then
        
'Apply command to copy cells
            DataRg(I).EntireRow.Copy Destination:=Workbooks("Test2PasteLocation").Worksheets("Sheet1").Range("A" & Q + 1)
            Q = Q + 1
        End If
    Next
    Application.ScreenUpdating = True

End Sub

Then close the pasting location:

VBA Code:
Sub CloseTest2()
'Close a workbook

  Workbooks("Test2PasteLocation.xlsm").Close SaveChanges:=True
  
End Sub

Replace my words in the right columns:

VBA Code:
Sub FindReplace()
'Find the word "Yes" in column P, replace with "Moved"

ThisWorkbook.Worksheets("Warehouse_STOCK").Range("P:P").Replace What:="Yes", Replacement:="Moved to Inventory_IN", MatchCase:=True

End Sub

Hide the now change rows:

VBA Code:
Sub HideRows() 'Module 1

  Dim cell As Range

  For Each cell In ActiveWorkbook.ActiveSheet.Columns("P").Cells

      If cell.Value = "Moved to Inventory_IN" Then

      cell.EntireRow.Hidden = True

    End If

  Next cell

End Sub

No extra rows are copied over.

Since the test files work with the macros, I need to move to the actual files... which are on Sharepoint. I can't seem to figure out the right filepath name. Any help with this?
 
Upvote 0
I may have solved my issue. I recorded a macro and opened up the file through Excel from where it's located on OneDrive/Sharepoint. The macro now references the correct file. Haven't tested it yet, as I'm waiting on management to tell me which cells they change so I can reference the right words.
 
Upvote 0

Forum statistics

Threads
1,214,833
Messages
6,121,868
Members
449,053
Latest member
Mesh

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