Copy Paste Macro

NPandelos

New Member
Joined
May 3, 2022
Messages
12
Office Version
  1. 365
Please bare with me on this. I'm looking for some help with a copy paste macro I'm trying to write.

What I'm trying to do is look to see if there is a value in the "Stock Code" column. If there is look at the "Item Type & Action" columns depending on those values.
1661335593274.png

The "release" would have the cell cell value paste-text into the first blank cell in a different sheet.
1661342320849.png

If it is "change" the cell value would be paste-text into the first two blank cells in different sheet.
1661342351166.png


So far this is my code, but I am unsure what to put for the ranges.

Sub CopyStockCodeUpdates()
'
' CopyStockCodeUpdates Macro
Dim scNum, scCount As Integer
Dim scCurrent, sheetCurrent As String

Application.ScreenUpdating = False

Sheets("Engineering Input Form").Select
Range("B6").Select
'scCount = 0
scNum = 1

'Is there a stock code in the current cell? If so, continue.
While ActiveCell.Value <> ""
'Is this line a RELEASE? If so, copy active cell & paste text to "New Stock Code"
If Range("D" & (ActiveCell.Row)).Value = "SC - STOCK CODE" And Range("F" & (ActiveCell.Row)).Value = "RELEASE" Then
Selection.Copy
Sheets("New Stock Code").Select
Range ()
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Is this line a CHANGE? If so, copy active cell & paste text to "Stock Code Updates"
If Range("D" & (ActiveCell.Row)).Value = "SC - STOCK CODE" And Range("F" & (ActiveCell.Row)).Value = "RELEASE" Then
Selection.Copy
Sheets("Stock Code Updates").Select
Range()
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If

scNum = scNum + 1
Sheets("Worksheet").Select
ActiveCell.Offset(1, 0).Select
Wend

Application.ScreenUpdating = True

End Sub

Any help would be greatly appreciated.
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 
Upvote 0
I hope this worked. Below are the images from the original Posting

Item*StockCodeDescriptionItem TypeItem ListAction
507610-00FLANGE, PIVOTSC - STOCK CODE507610-00CHANGE
TP.1234.567STOCK CODE NOT FOUND REFRESH DATA OR PULL NUMBERSC - STOCK CODETP.1234.567RELEASE
507611-00Mount Monitor Secondary, LowerSC - STOCK CODECHANGE
507612-00Spacer, Secondary, ArmSC - STOCK CODECHANGE
507613-00PLATE, PRIMARY ARMSC - STOCK CODECHANGE
TP.5678.900STOCK CODE NOT FOUND REFRESH DATA OR PULL NUMBERSC - STOCK CODERELEASE
TP.6789.999STOCK CODE NOT FOUND REFRESH DATA OR PULL NUMBERSC - STOCK CODERELEASE
]="",[@[*StockCode]], IF(IFERROR(VLOOKUP([@[*StockCode]],'Syspro Stock Codes'!A:E,5,FALSE),"")<>"","STOCK CODE ALREADY ON ECN", IF(IFERROR(VLOOKUP([@[*StockCode]],Table_Query_from_SysproCompanyUS187[[StockCode]:[Description]],2,FALSE),"X")<>"X",VLOOKUP([@[*StockCode]],Table_Query_from_SysproCompanyUS187[[StockCode]:[Description]],2,FALSE), IF(IFERROR(VLOOKUP([@[*StockCode]],AllPartNumbersTPM!A:B,2,FALSE),"Y")<>"Y",VLOOKUP([@[*StockCode]],AllPartNumbersTPM!A:B,2,FALSE), "STOCK CODE NOT FOUND REFRESH DATA OR PULL NUMBER"))))]
]="",[@[*StockCode]], IF(IFERROR(VLOOKUP([@[*StockCode]],'Syspro Stock Codes'!A:E,5,FALSE),"")<>"","STOCK CODE ALREADY ON ECN", IF(IFERROR(VLOOKUP([@[*StockCode]],Table_Query_from_SysproCompanyUS187[[StockCode]:[Description]],2,FALSE),"X")<>"X",VLOOKUP([@[*StockCode]],Table_Query_from_SysproCompanyUS187[[StockCode]:[Description]],2,FALSE), IF(IFERROR(VLOOKUP([@[*StockCode]],AllPartNumbersTPM!A:B,2,FALSE),"Y")<>"Y",VLOOKUP([@[*StockCode]],AllPartNumbersTPM!A:B,2,FALSE), "STOCK CODE NOT FOUND REFRESH DATA OR PULL NUMBER"))))]


Stock CodeAbcAnalysisReqAbcCostingReq
507610-00
TP.1234.567


Stock CodeAbcAnalysisReqAbcCostingReqAlternateKey1 (Commodity Code)
From507610-00YNMET05
To507610-00
From507612-00YNMET05
To507612-00
From#N/A#N/A#N/A
To
 
Upvote 0
Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Engineering Input Form" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Double click the desired Stock Code in column B.
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    Application.ScreenUpdating = False
    If Target.Offset(, 2) = "SC - STOCK CODE" And Target.Offset(, 4) = "RELEASE" Then
        With Sheets("New Stock Code")
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target
        End With
    ElseIf Target.Offset(, 2) = "SC - STOCK CODE" And Target.Offset(, 4) = "CHANGE" Then
        With Sheets("Stock Code Updates")
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(2) = Target
        End With
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Engineering Input Form" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Double click the desired Stock Code in column B.
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    Application.ScreenUpdating = False
    If Target.Offset(, 2) = "SC - STOCK CODE" And Target.Offset(, 4) = "RELEASE" Then
        With Sheets("New Stock Code")
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target
        End With
    ElseIf Target.Offset(, 2) = "SC - STOCK CODE" And Target.Offset(, 4) = "CHANGE" Then
        With Sheets("Stock Code Updates")
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(2) = Target
        End With
    End If
    Application.ScreenUpdating = True
End Sub
That worked great. If I wanted to set up a button to activate the macro, I should be able to assign the macro to a button correct or would there be something else I would need to do?
 
Upvote 0
If you want to assign the task to a button, use this version of the macro and place it in a regular module not the sheet module. The macro assumes that you first click to select the desired Stock Code in column B.
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    If ActiveCell.Offset(, 2) = "SC - STOCK CODE" And ActiveCell.Offset(, 4) = "RELEASE" Then
        With Sheets("New Stock Code")
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = ActiveCell
        End With
    ElseIf ActiveCell.Offset(, 2) = "SC - STOCK CODE" And ActiveCell.Offset(, 4) = "CHANGE" Then
        With Sheets("Stock Code Updates")
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(2) = ActiveCell
        End With
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
My apologies for being a pain but I'm still new to writing excel macros. I took what you posted and tried to modify it so it will loop thru the Stock code field until it finds an empty cell. But for some reason it keeps only populating the active cell in to the other sheets. It gets the count right it just adds the same number. It isn't looping. I thought I could just get away with adding a while loop.

VBA Code:
Sub CopyData()
    Dim LSearchow As Integer
    LSearchRow = 5

    Application.ScreenUpdating = False

    'Loop thru Stock Code until finds empty cell
    While Len(Range("B" & CStr(LSearchRow)).Value) > 0
        'Looks at Stock code & Type of change
        If ActiveCell.Offset(, 2) = "SC - STOCK CODE" And ActiveCell.Offset(, 4) = "RELEASE" Then
            'Copies to appropriate worksheet
            With Sheets("New Stock Code")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = ActiveCell
            End With
        'Looks at Stock code & Type of change
        ElseIf ActiveCell.Offset(, 2) = "SC - STOCK CODE" And ActiveCell.Offset(, 4) = "CHANGE" Then
            'Copies to appropriate worksheet
            With Sheets("Stock Code Updates")
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(2) = ActiveCell
            End With
        End If
        LSearchRow = LSearchRow + 1
    Wend
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try:
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim SC As Range
    For Each SC In Range("B5", Range("B" & Rows.Count).End(xlUp))
        If SC.Offset(, 2) = "SC - STOCK CODE" And SC.Offset(, 4) = "RELEASE" Then
            With Sheets("New Stock Code")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = SC
            End With
        ElseIf SC.Offset(, 2) = "SC - STOCK CODE" And SC.Offset(, 4) = "CHANGE" Then
            With Sheets("Stock Code Updates")
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(2) = SC
            End With
        End If
    Next SC
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,352
Messages
6,124,449
Members
449,160
Latest member
nikijon

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