Forum Discussion
Macro to copy
Thanks for your response - from the top
Q? (random)
Y47
Auto
365 Home V2508 Build 20240
.xlsm
11 Home 10.0.26100
HDD (but copied to OneDrive)
See ScreenShot
I use MS-Defender
MacroCopyStockHoldingToSale
In “Excel” I need to automatically copy the “Stock Holding” Value showing in Column (Q), to the requesting cell in Column (Y).
This Value is not in the same Row because the sale occurs on a random date, days or months after the “Bought Date”. (Rows 95 and 96 are set up for Testing)
The Trigger for this is an entry into Columns (V and W) in the Row associated to the Sale which is automatically copied.
Maybe a Macro has to search downwards from Row (1) in Columns (O7 and P7 and Q7) to find the Oldest Matching “Code and Units and a Positive Value” and then copy the Value from Column (Q) to the Target Cell in “CODE” (Column (Y).
To complete the action the program should return to the Source Cell in Column (Q) which is an Active Value in Purple Color with no fill and reformat the Value in that cell to an Inactive Value, by use of an apostrophe, change the Color to Red and make the Fill Yellow.
This is the new revised copy
Sub CopyStockHoldingToSale()
Dim ws As Worksheet
Dim saleRow As Long
Dim saleCode As String
Dim saleUnits As Double
Dim targetRow As Long
Dim sourceRow As Long
Dim lastRow As Long
' Set worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your actual sheet name
' Define the row where the sale is recorded saleRow = 7 ' Change this if needed
' Get sale details
saleCode = ws.Cells(saleRow, "O").Value
saleUnits = ws.Cells(saleRow, "P").Value
targetRow = saleRow ' Assuming you want to copy to same row in column Y
' Find the last row with data in column O
lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
' Loop from top to bottom to find the oldest matching entry For sourceRow = 1 To lastRow
If ws.Cells(sourceRow, "O").Value = saleCode And _ ws.Cells(sourceRow, "P").Value = saleUnits Then
' Check if Q is numeric and positive
If IsNumeric(ws.Cells(sourceRow, "Q").Value) Then
If ws.Cells(sourceRow, "Q").Value > 0 Then
' Copy value from column Q to column Y
ws.Cells(targetRow, "Y").Value = ws.Cells(sourceRow, "Q").Value
Exit For End If
End If End If
Next sourceRow End Sub
✅ Updated Requirements ex CoPilot
- Search from Row 1 downward in columns O, P, and Q.
- Find the oldest row where:
o Column O matches saleCode
o Column P matches saleUnits
o Column Q contains a positive numeric value
- Copy the value from column Q to column Y in the “Stock Holding” row.
- Ignore any cells in column Q that:
- Are text (e.g., '123 or '0)
- Are non-numeric
- Are zero or negative
Problem = Excel sees TEXT cell Q37 as Zero but Macro sees it as a value 11,700.00 ??
So far i understand…
Requirements :
- Search from row 1 downward in columns O (Code), P (Units), Q (Stock Holding).
- Find the oldest row where:
- Column O = saleCode
- Column P = saleUnits
- Column Q is numeric and positive
- Ignore text, zero, or negative numbers
- Copy the value from Q to Y in the sale row
- After copying, mark the source cell as inactive:
- Prefix with apostrophe (')
- Font color red, fill color yellow
Here’s a VBA macro:
Sub CopyStockHoldingToSale()
Dim ws As Worksheet
Dim saleRow As Long
Dim saleCode As String
Dim saleUnits As Double
Dim targetRow As Long
Dim sourceRow As Long
Dim lastRow As Long
Dim cellValue As Double
' Set worksheet (change as needed)
Set ws = ThisWorkbook.Sheets("Sheet1")
' Define the row where the sale is recorded
saleRow = 7 ' Change to the row where the sale occurs
' Get sale details
saleCode = ws.Cells(saleRow, "O").Value
saleUnits = ws.Cells(saleRow, "P").Value
targetRow = saleRow ' Copy to column Y in the same row
' Find the last row with data in column O
lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
' Loop from top to bottom to find the oldest matching entry
For sourceRow = 1 To lastRow
' Check code and units match
If ws.Cells(sourceRow, "O").Value = saleCode And _
ws.Cells(sourceRow, "P").Value = saleUnits Then
' Only consider numeric and positive values in Q
If IsNumeric(ws.Cells(sourceRow, "Q").Value) Then
cellValue = CDbl(ws.Cells(sourceRow, "Q").Value)
If cellValue > 0 Then
' Copy value to target cell in column Y
ws.Cells(targetRow, "Y").Value = cellValue
' Format the source cell as inactive
With ws.Cells(sourceRow, "Q")
.Value = "'" & cellValue ' Prefix with apostrophe
.Font.Color = vbRed
.Interior.Color = vbYellow
End With
Exit For ' Stop after the first match
End If
End If
End If
Next sourceRow
' Optional: Message if no match found
If ws.Cells(targetRow, "Y").Value = "" Then
MsgBox "No matching positive stock holding found.", vbExclamation
End If
End Sub
You can upgrade this macro to automatically trigger whenever a value is entered in Columns V or W, so you don’t have to run it manually every time. This would fully automate your workflow.
Here the auto trigger code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim saleRow As Long
Dim saleCode As String
Dim saleUnits As Double
Dim targetRow As Long
Dim sourceRow As Long
Dim lastRow As Long
Dim cellValue As Double
Set ws = Me ' Refers to this sheet
' Only trigger if change happened in column V or W
If Intersect(Target, ws.Range("V:W")) Is Nothing Then Exit Sub
' Determine the row where the change happened
saleRow = Target.Row
targetRow = saleRow ' Copy to column Y in the same row
' Get sale details from columns O and P in the same row
saleCode = ws.Cells(saleRow, "O").Value
saleUnits = ws.Cells(saleRow, "P").Value
' Find last row with data in column O
lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
' Loop from top to bottom to find the oldest matching entry
For sourceRow = 1 To lastRow
If ws.Cells(sourceRow, "O").Value = saleCode And _
ws.Cells(sourceRow, "P").Value = saleUnits Then
If IsNumeric(ws.Cells(sourceRow, "Q").Value) Then
cellValue = CDbl(ws.Cells(sourceRow, "Q").Value)
If cellValue > 0 Then
' Copy value to target cell in column Y
ws.Cells(targetRow, "Y").Value = cellValue
' Format the source cell as inactive
With ws.Cells(sourceRow, "Q")
.Value = "'" & cellValue
.Font.Color = vbRed
.Interior.Color = vbYellow
End With
Exit For
End If
End If
End If
Next sourceRow
End Sub
My answers are voluntary and without guarantee!
Hope this will help you.
- Valdon1070Oct 04, 2025Copper Contributor
NikolinoDE, many thanks for your response but I am not getting anywhere. This could easily be fixed if I could send you my workbook but the system won't let me. It's on OneDrive and I could share it if I had the required link. how about that?
- Valdon1070Oct 08, 2025Copper Contributor
NikolinoDE, sorry to be a nuisance but I can't get this started. I have tried to copy but no luck. Will send by Message system??. Excel objects to Line 1 saying "End Sub expected" and also doesn't like the "Me" in Line 11