Solved: Auto data entry

[ming]

Hi,


Pls see attached the sample file. (sample file is 3 sheets only, but the actual is more then 30 sheets)


Range I18 - I39 is "description"
Range D18 - D39 is "Item No."
Cell I48 is Remark


If Range "Descrirption" contains "IPS" or "IP" or "IP*"then the item no & "Plating for ....." will auto entry in Cell.I48

Any help will be highly appreciated !

[Bob Phillips]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(Target, Sh.Range("nw_invoice_item_name")) Is Nothing Then

msg = "Item no. "
For Each cell In Sh.Range("nw_invoice_item_name").Columns(1).Cells

If cell.Value Like "*IP*" Then

msg = msg & Sh.Cells(cell.Row, Sh.Range("nw_invoice_item_index").Column).Value & ", "
End If
Next cell
msg = msg & " Plating for " & Sh.Range("nw_customer_name").Cells(1, 1).Value & _
" Inv.# " & Sh.Range("nw_invoice_no").Cells(1, 1).Value
Sh.Range("I48").Value = msg
End If
End Sub


This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

[ming]

Is it possible to copy in commdbutton? Thanks!

[Aussiebear]

Certainly is. What did you want to copy and where to?

[ming]

I want copy/change this "workbook event code" to a commdbutton & save in a new file. Once I click the button then the invoice file can be updated.

one more question.
If Range "Descrirption" not contains "*IP*" then Cell.I48 is empty.
I try to use : Else msg = ""
but failed.
How to change the code? Thanks!


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(Target, Sh.Range("nw_invoice_item_name")) Is Nothing Then

msg = "Item no. "
For Each cell In Sh.Range("nw_invoice_item_name").Columns(1).Cells

If cell.Value Like "*IP*" Then

msg = msg & Sh.Cells(cell.Row, Sh.Range("nw_invoice_item_index").Column).Value & ", "
End If
Next cell
msg = msg & " Plating for " & Sh.Range("nw_customer_name").Cells(1, 1).Value & _
" Inv.# " & Sh.Range("nw_invoice_no").Cells(1, 1).Value
Sh.Range("I48").Value = msg
End If
End Sub

[Bob Phillips]

Private Sub CommandButton1_Click()
Dim msg As String

msg = "Item no. "
With ActiveSheet

For Each cell In .Range("nw_invoice_item_name").Columns(1).Cells

If cell.Value Like "*IP*" Then

msg = msg & .Cells(cell.Row, .Range("nw_invoice_item_index").Column).Value & ", "
End If
Next cell
msg = msg & " Plating for " & .Range("nw_customer_name").Cells(1, 1).Value & _
" Inv.# " & .Range("nw_invoice_no").Cells(1, 1).Value
.Range("I48").Value = msg
End With
End If
End Sub

[ming]

First sheet change only. I want update for all. Thanks!

[Bob Phillips]

Don't understand what that means.

[ming]

Sorry! I mean the code you gave me is just work for the first sheet, it doesn?t work on 2-3 sheets.

other problem : If cell.Value Like "*IP*" Then msg = msg & .......
--> How to change : if not contains *IP* then cell .I48 is empty

Thanks!

[Bob Phillips]

Private Sub CommandButton1_Click()
Dim msg As String
Dim sh

For Each sh In Worksheets(Array("Sheet1", "Sheet2"))

msg = "Item no. "
With sh

For Each cell In .Range("nw_invoice_item_name").Columns(1).Cells

If cell.Value Like "*IP*" Then

msg = msg & .Cells(cell.Row, .Range("nw_invoice_item_index").Column).Value & ", "
End If
Next cell
msg = msg & " Plating for " & .Range("nw_customer_name").Cells(1, 1).Value & _
" Inv.# " & .Range("nw_invoice_no").Cells(1, 1).Value
.Range("I48").Value = msg
End With
Next sh
End Sub

[ming]

Thanks, but there's a problem : eg Sheet2 is not contains any *IP*, so cell I48 should be blank, however Cell I48 still display : Item no. Plating for .... --> I want to delete this please ! Thanks!!

[Bob Phillips]

Private Sub CommandButton1_Click()
Dim msg As String
Dim sh

For Each sh In Worksheets(Array("Sheet1", "Sheet2"))

msg = "Item no. "
With sh

For Each cell In .Range("nw_invoice_item_name").Columns(1).Cells

If cell.Value Like "*IP*" Then

msg = msg & .Cells(cell.Row, .Range("nw_invoice_item_index").Column).Value & ", "
End If
Next cell
If msg = "Item no. " Then

msg = ""
Else

msg = msg & " Plating for " & .Range("nw_customer_name").Cells(1, 1).Value & _
" Inv.# " & .Range("nw_invoice_no").Cells(1, 1).Value
End If

.Range("I48").Value = msg
End With
Next sh
End Sub

[ming]

It's working now, Thank you again XLD :bow: