Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 7 of 7

Thread: Public?!

  1. #1
    Board Regular
    Join Date
    Feb 2002
    Location
    Hengelo
    Posts
    79
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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,

    Best regards,

    Martin J.A. Maatman Oonk

  2. #2
    Guest

    Default

    Try :-

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

  3. #3
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  4. #4
    Board Regular
    Join Date
    Apr 2002
    Location
    Cape Town,South Africa
    Posts
    234
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hello friend

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

  5. #5
    Board Regular
    Join Date
    Feb 2002
    Posts
    3,184
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.....
    Free Excel based Web Toolbar available here.

    Jack in the UK
    J & R Excel Solutions
    "making Excel work for you"

  6. #6
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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:

    Code:
    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 ]

  7. #7
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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):
    Code:
    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 ]

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •