Posts by yegarboy

Sub SaveChanges()


MSG = MsgBox("Proceed With Changes?", vbYesNo, "Proceed?")


If MSG = vbYes Then
  MsgBox "Changes Saved!"
  Sheets("computation").Range("I7:Y27, J54:N200, J44:M50").ClearContents
Else
  MsgBox "Changes Not Saved"
  Application.Undo
End If


End Sub

Dim Answer As String
   Dim MyNote As String


    'Place your text here
    MyNote = "Shall I Save Your Work Now?"


    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Save Changes")


    If Answer = vbNo Then
        'Code for No button Press
     MsgBox "No Problem. We'll Just Send The Workbook As Is."
    Else
        'Code for Yes button Press
       ActiveWorkbook.Save
    End If
MsgBox "There Will Be A Brief Pause While I Attach Your Workbook. A Temp File Is Being Placed On Your Desktop."


ChDir "C:\Users\YOURNAME\Desktop" '<<< Change as needed
    ActiveWorkbook.SaveAs Filename:="C:\Users\ValdostaMill\Desktop\ToBeEmailed.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 ActiveWorkbook.SendMail Recipients:="", _
          Subject:=" Here Is Your Workbook "

Sub Macro99() 
     
     'Step 1:  Declare your variables
    Dim PP As PowerPoint.Application 
    Dim PPPres As PowerPoint.Presentation 
    Dim PPSlide As PowerPoint.Slide 
    Dim SlideTitle As String 
     
     'Step 2:  Open PowerPoint and create new presentation
    Set PP = New PowerPoint.Application 
    Set PPPres = PP.Presentations.Add 
    PP.Visible = True 
     
     'Step 3:  Add new slide as slide 1 and set focus to it
    Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly) 
    PPSlide.Select 
     
     'Step 4:  Copy the range as a picture
    Sheets("Slide Data").Range("A1:J28").CopyPicture _ 
    Appearance:=xlScreen, Format:=xlPicture 
     
     'Step 5:  Paste the picture and adjust its position
    PPSlide.Shapes.Paste
    PPSlide.Shapes.Select 'After Pasting Select the Shape. This is a separate line of code.
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 'Because this line deals with "Selection" is why
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
     
     'Step 6:  Add the title to the slide
    SlideTitle = "My First PowerPoint Slide" 
    PPSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle 
     
     'Step 7:  Memory Cleanup
    PP.Activate 
    Set PPSlide = Nothing 
    Set PPPres = Nothing 
    Set PP = Nothing 
     
End Sub

Sub Admin()


   Dim Code
   Code = InputBox(Prompt:="Please enter the code.", Title:="ENTER THE CODE", Default:="")
    If Code = "7980" Then
        For i = 1 To Sheets.Count
            Sheets(i).Visible = True
        Next
    Else
        MsgBox ("Incorrect Code")
    End If
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)


    Const WS_RANGE As String = "N1" '<== change to suit
      Const WS_RANGE2 As String = "O1" '<== change to suit
      
    On Error GoTo ws_exit
    Application.EnableEvents = False
     
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        Me.Range("A1:D1").AutoFilter field:=3, Criteria1:="*" & Target.Value & "*"
    End If
     
      If Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then
        Me.Range("A1:D1").AutoFilter field:=4, Criteria1:="*" & Target.Value & "*"
    End If
     
     
ws_exit:
    Application.EnableEvents = True
    
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)


    Const WS_RANGE As String = "N1" '<== change to suit
      Const WS_RANGE2 As String = "O1" '<== change to suit
      
    On Error GoTo ws_exit
    Application.EnableEvents = False
     
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        Me.Range("A1:D1").AutoFilter field:=3, Criteria1:=Target.Value
    End If
     
      If Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then
        Me.Range("A1:D1").AutoFilter field:=4, Criteria1:=Target.Value
    End If
     
     
     
ws_exit:
    Application.EnableEvents = True
End Sub