View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ryan H Ryan H is offline
external usenet poster
 
Posts: 489
Default Need another eye on this Sub()

I shortened this code by deleting some things that I thought were
unneccessary but I could be wrong. The bulk of your code depends on the
Target Range being B4 or B5 otherwise nothing interesting happens? Maybe
that is your issue? Try this code below.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strFileName As String
Dim ws As Worksheet

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

Range("B4").Select

If Target.Address = "$B$4" Then
Range("B5").Select
ElseIf Target.Address = "$B$5" Then

Application.EnableEvents = False
Range("B1").Value = Range("B4").Value & ": " & Range("B5").Value & "
" & Range("D4").Value
strFileName = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) -
4)
ActiveWorkbook.SaveCopyAs Range("B4").Value & "_" &
Range("B5").Value & "_" & _
strFileName & "_" & Format(Date,
"mmmdd_yy") & ".xls"
Application.Calculation = xlCalculationAutomatic

For Each ws In Worksheets
If ws.Name < "BO Download" Then
ws.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("A2").Select
Else
ws.Delete
End If
Next ws

Call formulas
Range("A3").Select
Sheets("Graphes Table").Visible = False
ActiveWorkbook.Save
Application.EnableEvents = True
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

--
Cheers,
Ryan


"Ayo" wrote:

when I run this sub, it seem like everything is fine except, nothing whitin
the sub is executed.
What am I missing?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim filename As String, ws As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Range("B4").Select

If Target.Address() = "$B$4" And Target.Address() < "" Then
Application.EnableEvents = False
Range("B5").Select
Application.EnableEvents = True

ElseIf Target.Address() = "$B$5" And Target.Address() < "" Then
Application.EnableEvents = False
Range("B1") = Range("B4") & ": " & Range("B5") & " " & Range("D4")
filename = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4)
ActiveWorkbook.SaveCopyAs Range("B4") & "_" & Range("B5") & "_" &
filename & "_" & Format(Date, "mmmdd_yy") & ".xls"
Application.Calculation = xlCalculationAutomatic
For Each ws In Workbook
If ws.Name < "BO Download" Then
ws.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("A2").Select
End If
Next ws
Worksheets("BO Download").Select
Worksheets("BO Download").Delete
Call formulas
Range("A3").Select
Worksheets("Graphes Table").Visible = False
ActiveWorkbook.Save
Application.EnableEvents = True
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub