Copy any values in column Q to Column G

[tonywatsonhelp]

Hi Everyone,

OK so this is what I need.

when I run the macro,

Sheet "Stocked Products" has a list of all the products we stock in Rows 3:200

Column G is the current selling price.

Column Q is generated when the price from our suppliers has gone up or down to show a price change and shows the new price.
So I want a macro to update my Column G with new prices when the macro is run but not over write the ones that have not changed see example below.

Ideal would be macro is run and asks "There are new prices do you want to update?"
if I select yes do it
No exit sub

	A		G			Q
1
2
3	Product	other columns	Current Price	other	columns	New Price
4	cup		10.00
5	spoon		11.00			15.00	so the macro would replace G5 with 15.00 as this is the new price
6	hat		5.00				but the ones with no one price don't change.
7coat	coat		7.00
8	fork		4.00
9	spoon		9.00			7.00
10	duck		12.00

<tbody>
</tbody>

 

[Eric W]

Try:

Sub UpdatePrices()
Dim MyData As Variant, i As Long, ctr1 As Long

    MyData = Range("A4:Q" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    
    For i = 1 To UBound(MyData)
        If MyData(i, 17) <> "" Then
            If MyData(i, 17) <> MyData(i, 3) Then ctr1 = ctr1 + 1
        End If
    Next i
            
    If ctr1 = 0 Then
        MsgBox "No changes found."
        Exit Sub
    End If
    
    If MsgBox(ctr1 & " changes found.  Continue?", vbYesNo, "Change status") = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For i = 1 To UBound(MyData)
        If MyData(i, 17) <> "" Then
            If MyData(i, 17) <> MyData(i, 3) Then Cells(i + 3, "C") = Cells(i + 3, "Q")
        End If
    Next i
    
    Application.ScreenUpdating = True
        
End Sub

Let us know if you need help installing it.

 

[tonywatsonhelp]

Hi Eric,
This is great thank you very much
Tony

 

[Eric W]

Urk! I just noticed, your current price is in column G, not C. You'll need to make the following changes:

Sub UpdatePrices()
Dim MyData As Variant, i As Long, ctr1 As Long


    MyData = Range("A4:Q" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    
    For i = 1 To UBound(MyData)
        If MyData(i, 17) <> "" Then
            If MyData(i, 17) <> MyData(i, 7) Then ctr1 = ctr1 + 1
        End If
    Next i
            
    If ctr1 = 0 Then
        MsgBox "No changes found."
        Exit Sub
    End If
    
    If MsgBox(ctr1 & " changes found.  Continue?", vbYesNo, "Change status") = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For i = 1 To UBound(MyData)
        If MyData(i, 17) <> "" Then
            If MyData(i, 17) <> MyData(i, 7) Then Cells(i + 3, "G") = Cells(i + 3, "Q")
        End If
    Next i
    
    Application.ScreenUpdating = True
        
End Sub

 

[Fluff]

Another option if your interested

Sub Copyprice()
   With Range("G5", Range("G" & Rows.count).End(xlUp))
      .Value = Evaluate(Replace(Replace("if(@q="""",@,@q)", "@q", .Offset(, 10).Address), "@", .Address))
   End With
End Sub