Forum Discussion
Macro to copy
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.
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