Posts by mrmmickle1

Sub Test()


Dim x As String
'Note: GetSaveAsFilename doesn't save the workbook, it just returns a filename.
x = Application.GetSaveAsFilename(InitialFileName:="New File.xlsx")
If x = "False" Then Exit Sub 'User did not select option or canceled the dialog
ActiveWorkbook.SaveAs x


End Sub

Private Sub ComboBox1_Change()
    Dim MMod As Range
    Dim MFind As Range
    Dim myFlag As Boolean
    
    Set MMod = Worksheets("Validate").Range("R2:R8")
    For Each MFind In MMod
        If MFind.Value = ComboBox1.Value Then
            myFlag = True
            Sheets("Validate").Range("R1").Select
            Do
                If ActiveCell.Value = ComboBox1.Value = False Then
                    ActiveCell.Offset(1, 0).Select
                End If
            Loop Until ActiveCell.Value = ComboBox1.Value
            textbox1.Value = ActiveCell.Offset(0, 1).Value
             
             
        End If
         
    Next MFind
    
    If myFlag = False Then textbox1.Value = "Zero"
    
End Sub

Sub Test()
     
    Dim LngLp           As Long
    Dim LRow            As Long
    Dim BottomCll       As Long
     
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
     
    'Find last cell when dealing with empty cells in columns....
    LRow = Sheets("Sheet1").Cells.Find(What:="*", _
    After:=Range("A1"), _
    LookAt:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, _
    MatchCase:=False).Row
     
    BottomCll = LRow 'Define Bottom Cell of Table
    For LngLp = LRow To 1 Step -1
        If Sheets("Sheet1").Cells(LngLp, "A").Font.Bold Then 'Look for table start cells by identifying them based on bold lettering
            ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count) 'Add Worksheet
            Sheets("Sheet1").Range("A" & LngLp & ":C" & BottomCll).Copy ActiveSheet.Range("A1") 'Copy Table Data to newly added worksheet
            BottomCll = LngLp - 2 'Reset Bottom Cell of Table
        End If
    Next LngLp
    
    Sheets("Sheet1").Delete
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = False
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
     
End Sub

Sub Test()
 
    Dim LngLp           As Long
    Dim LRow            As Long
    Dim BottomCll       As Long
    
    'Find last cell when dealing with empty cells in columns....
    LRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
    
    BottomCll = LRow 'Define Bottom Cell of Table
    For LngLp = LRow To 1 Step -1
        If Cells(LngLp, "A").Font.Bold Then 'Look for table start cells by identifying them based on bold lettering
            ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count) 'Add Worksheet
            Sheets("Sheet1").Range("A" & LngLp & ":C" & BottomCll).Copy ActiveSheet.Range("A1") 'Copy Table Data to newly added worksheet
            BottomCll = LngLp - 2 'Reset Bottom Cell of Table
        End If
    Next LngLp




End Sub

Private Sub Worksheet_Change(ByVal Target As Range)


   Dim LastRow As Long
    
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & LastRow + 1) = Range("a1")
    Range("B" & LastRow + 1) = Range("e1")'TimeStamp????




End Sub

Private Sub Worksheet_Change(ByVal Target As Range)


    If Format(Range("C3"), "hh:mm:ss") = "00:05:00" Then '5 minute mark
        Range("A5") = Now()
    ElseIf Format(Range("C3"), "hh:mm:ss") = "00:02:00" Then
        Range("A6") = Now()
    ElseIf Format(Range("C3"), "hh:mm:ss") = "00:01:00" Then
       Range("A7") = Now()
    End If
    
End Sub

Private Sub CommandButton3_Click()    ' Delete Button
    Dim sil As Long
    If ListBox1.ListIndex = -1 Then
        MsgBox "Choose an entry", vbExclamation
        Exit Sub
    End If
    If ListBox1.ListIndex >= 0 Then
        cevap = MsgBox("Entry will be deleted. ... Are you sure ?", vbYesNo)
        If cevap = vbYes Then
            sil = Sheets("Data").Range("A1").CurrentRegion.Columns(1).Find(ListBox1.Text).row
            Sheets("Data").Rows(sil).EntireRow.Delete
        Else '<--------These Two Lines
            Exit Sub '<------
        End If
    End If
    Call Main    'Progress Bar




    For a = 1 To 12
        Controls("textbox" & a) = ""
    Next




    ListBox1.List = Sheets("Data").Range("al").CurrentRegion.Offset(1).Value
    TextBox14.Value = ListBox1.ListCount
End Sub