Worksheet Change to build product list

[Andy Brown]

Hi all ; I'd like to build something useful IMO, any help would be
appreciated. As ever, for the record, I don't do proper VBA (Dim, Set,
whatever).

It's an invoice thingy. For starters, there's 2 sheets - "Input" (the
invoice form, in A2:Fx) and Sheet2 for the table of products & prices
(A2:Bx).

I'd like a Worksheet_Change for Input!C:C ("Item"), If Target.Column = 3
Then etc. When an item is entered, the code should check whether the item
already exists in Sheet2!A:A on the table sheet. If it does, it should pull
in the price from Sheet2!B:B to Target.Offset(0,1). If it doesn't, it should
run an input box ("How much is this item?") which then adds the item & price
to Sheet2!A:B.

I can kludge it to a point, but I'm fed up with doing that. Anyways, I know
I'll get stuck eventually since I can never get
Range("Sheet2!A_whatever").Value = Target.Value to work (i.e. writing from
the event sheet to another).

Posting what I have is pointless in the sense that none of you would ever
use anything so ugly, on the other hand it might give one or two a
much-needed chuckle at the near-end of a long week. I promise I'll try &
understand any replies.

TIA,
Andy

If Target.Column = 3 Then
'Trap DEL
If Target = "" Then Exit Sub
Range("Input!H1").Value = Target.Value
'I1 formula = "=IF(ISNA(MATCH(H1,Items,0)),0,1)"
If Range("I1") = 0 Then
MsgBox "New."
'Inputbox proc
Else
Application.EnableEvents = False
Target.Range("B1").FormulaR1C1 = "=VLOOKUP(RC[-1],Prices,2,False)"
Target.Range("B1").Value = Target.Range("B1").Value
Application.EnableEvents = True
End If
End If

 

[Frank Kabel]

Hi
try the following code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim target_wks As Worksheet
Dim target_rng As Range
Dim last_row As Long
Dim ret_price

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Range("C:C"), Target) Is Nothing Then Exit Sub
On Error GoTo errhandler
Application.EnableEvents = False
Set target_wks = Me.Parent.Worksheets("Sheet2")
Set target_rng = target_wks.Range("A:B")

With Target
If .Value <> "" And .Offset(0, 1).Value = "" Then
ret_price = Application.VLookup(.Value, target_rng, 2, 0)
If IsError(ret_price) Then
ret_price = Application.InputBox("Enter the price for: " & _
.Value, Type:=1)
last_row = target_wks.Cells(target_wks.Rows.Count, "A"). _
End(xlUp).Row
target_wks.Cells(last_row + 1, 1).Value = .Value
target_wks.Cells(last_row + 1, 2).Value = ret_price
End If
Application.EnableEvents = False
.Offset(0, 1).Value = ret_price

End If
End With

errhandler:
Application.EnableEvents = True
End Sub

 

[Bob Phillips]

ANdy,

A starter for 10

Private Sub Worksheet_Change(ByVal Target As Range)
Dim newPrice
Dim matched

Application.EnableEvents = False
On Error GoTo ws_exit
With Target
If .Column = 3 Then
'Trap DEL
If .Value <> "" Then
On Error Resume Next
matched = WorksheetFunction.Match(.Value,
Worksheets("Table").Range("items"), 0)
On Error GoTo 0
If matched = 0 Then
Worksheets("Table").Range("Prices")(2,
1).EntireRow.Insert
Worksheets("Table").Range("Prices")(2, 1).Value = .Value
newPrice = InputBox("Please supply price")
Worksheets("Table").Range("Prices")(2, 2).Value =
newPrice
End If
.Offset(0, 1).FormulaR1C1 =
"=VLOOKUP(RC[-1],Prices,2,False)"
End If
End If
End With

ws_exit:
Application.EnableEvents = True
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Andy Brown]

Thanks both, outstanding. Frank, I'll go with Bob's if that's OK, there's
less to follow. <g>

Bob, you left out the hard-coding! No prob, I can handle that bit, at least.

Best rgds,
Andy

 

[Bob Phillips]

I was confident you could Andy <vbg>.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Frank Kabel]

Hi
sure this is o.k