Public?!

[MJA]

Hello Mr. Excel,

How can I make the macro as shown below, work for each sheet in a workbook?
I don’t want to copy the macro on to every sheet in VB.
Can I do the trick with a “public” command or something like that?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 3 Then
ThisRow = Target.Row
If Target.Value <> "" And Target.NumberFormat = "General" Then
Range("D" & ThisRow).FormulaR1C1 = "=VLOOKUP(RC[-1],Armaturen!C[-3]:C[-2],2,0)"
Else
Range("D" & ThisRow).ClearContents
End If
End If
End Sub

Best regards,

Try :-

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

[Ivan F Moala]

On 2002-02-21 05:37, Anonymous wrote:
Try :-

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

Note This goes into the ThisWorkbook project module and NOT the Sheets code module

Ivan

[gareth]

Hello friend

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

[Jack in the UK]

garath

I would not highlight these but i have had a few complaints so im just showing you in case im not posting these to be picky or a jerk OK, but i have much email to day,, juts so you know.. I do not beleive in hiding behind PM or email, I get abused on this board notice i am not doing this to you, PLEASE dont get me wrong IM HELPING You and providing evedence.

Anno posted
Anonymous
Unregistered User Posted: 2002-02-21 05:37
--------------------------------------------------------------------------------
Try :-

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


A day later you posted
gareth
Board Master

Joined: Apr 16, 2002
Posts: 73
From: Cape Town,South Africa
Posted: 2002-04-22 04:27
--------------------------------------------------------------------------------
Hello friend

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


thisis the same answer??? is it not and has not helpped the issue or added a peice of worth to the feed???? and is a day late!

Ivan whoever has added anew direction which would have been visable at the time of your post.....

Like i say not having a go... just highlighting.....

[NateO]

You could copy the macro to each sheet module in the book. Or, as long as you don't have existing worksheet events, you can program to the VBE like the following:

Sub FlShtMds()
Dim ws As Worksheet, linum As Long
For Each ws In ActiveWorkbook.Worksheets
    With ActiveWorkbook.VBProject.VBComponents(ws.Name).CodeModule
        linenum = .CountOfLines + 1
        .InsertLines linenum, _
        "Private Sub Worksheet_Change(ByVal Target As Excel.Range)" & Chr(13) & _
        "If Target.Column = 3 Then" & Chr(13) & _
        "ThisRow = Target.Row" & Chr(13) & _
        "If Target.Value <> """" And Target.NumberFormat = ""General"" Then" & Chr(13) & _
        "Range(""D"" & ThisRow).FormulaR1C1 = ""=VLOOKUP(RC[-1],Armaturen!C[-3]:C[-2],2,0)""" & Chr(13) & _
        "Else" & Chr(13) & _
        "Range(""D"" & ThisRow).ClearContents" & Chr(13) & _
        "End If" & Chr(13) & _
        "End If" & Chr(13) & _
        "End Sub"
    End With
Next
End Sub

I simply replicated your code. It's probably easier to cut & past than write code like this, but if you a huge amount of worksheets to deal with... Hope this helps.

_________________
Cheers, NateO
"Me no are no nice guy."

[ This Message was edited by: NateO on 2002-04-25 11:26 ]

[NateO]

Wowee zowie, I can't believe I thought I was gettin' off that easy. Version 1 is fine and Dandy if your sheet name = the sheet module name, i.e, sheet1, sheet2, etc...But not so hot if you have original sheet names. But the following is more dynamic and allows for unique names(to be run from a normal module):

Sub FlShtMds2()
Dim ws As Worksheet, linum As Long
For Each ws In ThisWorkbook.Worksheets
    With thisWorkbook.VBProject.VBComponents(ws.codename).CodeModule
        linenum = .CountOfLines + 1
        .InsertLines linenum, _
        "Private Sub Worksheet_Change(ByVal Target As Excel.Range)" & Chr(13) & _
        "If Target.Column = 3 Then" & Chr(13) & _
        "ThisRow = Target.Row" & Chr(13) & _
        "If Target.Value <> """" And Target.NumberFormat = ""General"" Then" & Chr(13) & _
        "Range(""D"" & ThisRow).FormulaR1C1 = ""=VLOOKUP(RC[-1],Armaturen!C[-3]:C[-2],2,0)""" & Chr(13) & _
        "Else" & Chr(13) & _
        "Range(""D"" & ThisRow).ClearContents" & Chr(13) & _
        "End If" & Chr(13) & _
        "End If" & Chr(13) & _
        "End Sub"
    End With
Next
End Sub

My latest concept, get a band together and re-do Austin Powers To the BBC, only our version will sing To the VBE

Big props to Chip Pearson for making some highly leveragable code available on his site.

Have a great weekend y'all!

_________________
Cheers, NateO

[ This Message was edited by: NateO on 2002-07-09 09:12 ]