+ Reply to Thread
Results 1 to 6 of 6

Multiple Private subs

Hybrid View

LouiseH24 Multiple Private subs 12-14-2011, 12:49 PM
StephenR Re: Multiple Private subs 12-14-2011, 12:52 PM
LouiseH24 Re: Multiple Private subs 12-14-2011, 01:01 PM
StephenR Re: Multiple Private subs 12-14-2011, 01:13 PM
LouiseH24 Re: Multiple Private subs 12-14-2011, 01:18 PM
LouiseH24 Re: Multiple Private subs 12-14-2011, 01:15 PM
  1. 12-14-2011, 12:49 PM #1
    LouiseH24 is offline
    Registered User
    Join Date
    12-14-2011
    Location
    London, England
    MS-Off Ver
    Excel 2003
    Posts
    28

    Multiple Private subs

    Hiya,

    I am new to the forum!

    I am having an issue with my code that I have stored in the This Workbook Object - I have put together a Private Sub Workbook_Open and a Private Sub Workbook_SheetChange. Before it has finished running through the code in the workbook open sub, it seems to jump into the code for the workbook sheet change sub (seems to be each time it hits the Then part of a If condition).

    Is this a general issue in VBA or is this something to do with the way I have written my code?

    Thanks for your time.

    Lou
    Last edited by LouiseH24; 12-15-2011 at 11:16 AM.
    Reply With QuoteRegister To Reply
  2. 12-14-2011, 12:52 PM #2
    StephenR is offline
    Forum Guru
    Join Date
    08-26-2007
    Location
    London
    Posts
    4,606

    Re: Multiple Private subs

    I expect something in the Open code affects a sheet. Can you post your code?
    Reply With QuoteRegister To Reply
  3. 12-14-2011, 01:01 PM #3
    LouiseH24 is offline
    Registered User
    Join Date
    12-14-2011
    Location
    London, England
    MS-Off Ver
    Excel 2003
    Posts
    28

    Re: Multiple Private subs

    Sure thing:

    Private Sub Workbook_Open()
Dim a As Integer
Dim d As Integer
a = 4
d = 4
Do Until Range("B" & a) = "" And Range("B" & d) = ""
Columns("AA:AB").Select
    Selection.NumberFormat = "dd/mm/yyyy;@"
    Columns("AC:AC").Select
    Selection.NumberFormat = "General"
If Range("E" & a) = "" Then
a = a + 1
ElseIf Range("E" & a) <> "" Then
    If Range("E" & a) = "January" Then
    Range("AA" & a) = "01/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "February" Then
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        Range("AA" & a) = "02/01/2012"
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "March" Then
    Range("AA" & a) = "03/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "April" Then
    Range("AA" & a) = "04/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "May" Then
    Range("AA" & a) = "05/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "June" Then
    Range("AA" & a) = "06/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "July" Then
    Range("AA" & a) = "07/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "August" Then
    Range("AA" & a) = "08/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "September" Then
    Range("AA" & a) = "09/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "October" Then
    Range("AA" & a) = "10/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "November" Then
    Range("AA" & a) = "11/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    ElseIf Range("E" & a) = "December" Then
    Range("AA" & a) = "12/01/2012"
        If Range("F" & a) = "" Then
        Range("AB" & a) = "=TODAY()"
        ElseIf Range("F" & a) <> "" Then
        Range("F" & a).Select
        Selection.Copy
        Range("AB" & a).Select
        ActiveSheet.Paste Link:=True
        End If
    Range("AC" & a).FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
    End If
    a = a + 1
End If
d = a + 1
Loop
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim b As Integer
b = 4
Range("E" & b).Select
If Range("E" & b) = "January" Then
    If Range("AC" & b) >= -30 Then
    Range("F" & b).Select
    Selection.Interior.ColorIndex = 4
    ElseIf Range("AC" & b) <= -31 And Range("AC" & b) >= -59 Then
    Range("F" & b).Select
    Selection.Interior.ColorIndex = 44
    ElseIf Range("AC" & b) <= -60 Then
    Range("F" & b).Select
    Selection.Interior.ColorIndex = 3
    End If
ElseIf Range("E" & b) = "February" Then
    If Range("AC" & b) >= -30 Then
    Range("F" & b).Select
    Selection.Interior.ColorIndex = 4
    ElseIf Range("AC" & b) <= -31 And Range("AC" & b) >= -59 Then
    Range("F" & b).Select
    Selection.Interior.ColorIndex = 44
    ElseIf Range("AC" & b) <= -60 Then
    Range("F" & b).Select
    Selection.Interior.ColorIndex = 3
    End If
b = b + 1
End If
b = b + 1

End Sub
    I apologise if the code seems crude - I am new to private subs
    Reply With QuoteRegister To Reply
  4. 12-14-2011, 01:13 PM #4
    StephenR is offline
    Forum Guru
    Join Date
    08-26-2007
    Location
    London
    Posts
    4,606

    Re: Multiple Private subs

    Try adding this line after your d=4 line and turning it back on at the end: 
    Application.EnableEvents = False
    Btw you can dispense with most Selects, e.g. 
    Columns("AA:AB").NumberFormat = "dd/mm/yyyy;@"
    Reply With QuoteRegister To Reply
  5. 12-14-2011, 01:18 PM #5
    LouiseH24 is offline
    Registered User
    Join Date
    12-14-2011
    Location
    London, England
    MS-Off Ver
    Excel 2003
    Posts
    28

    Re: Multiple Private subs

    Perfect this seems to have worked!!
    Reply With QuoteRegister To Reply
  6. 12-14-2011, 01:15 PM #6
    LouiseH24 is offline
    Registered User
    Join Date
    12-14-2011
    Location
    London, England
    MS-Off Ver
    Excel 2003
    Posts
    28

    Re: Multiple Private subs

    Brilliant - thank you ever so much, I will give this a try
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1