Printable View
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 !
[vba]
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
[/vba]
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
Is it possible to copy in commdbutton? Thanks!
Certainly is. What did you want to copy and where to?
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
[vba]
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
[/vba]
First sheet change only. I want update for all. Thanks!
Don't understand what that means.
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!
[vba]
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
[/vba]
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!!
[vba]
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
[/vba]
It's working now, Thank you again XLD :bow: