Private Sub CB_SITE_ID_Click()
Dim i As Integer, answer As VbMsgBoxResult, lastrow As Long, x As Long
lastrow = Sheets("VVS Installations").Cells(Rows.Count, "B").End(xlUp).row
For x = 4 To lastrow
For i = 4 To lastrow
If Me.TX_TYPE_OF_FEEDBACK <> "" Then
If Me.TX_1.Value <> "" Then
If Sheets("VVS Installations").Cells(x, "B") = Me.TX_1.Value And Sheets("VVS Installations").Cells(x, "N") = 1 _
And Sheets("VVS Installations").Cells(x, "R") = 3 Then
Me.Controls("TX_1").Value = Worksheets("VVS Installations").Cells(i, "B")
Me.Controls("TX_2").Value = Worksheets("VVS Installations").Cells(i, "C")
Me.Controls("TX_3").Value = Worksheets("VVS Installations").Cells(i, "D")
Me.Controls("TX_4").Value = Worksheets("VVS Installations").Cells(i, "E")
Me.Controls("TX_5").Value = Worksheets("VVS Installations").Cells(i, "F")
Me.Controls("TX_6").Value = Worksheets("VVS Installations").Cells(i, "G")
Me.Controls("TX_7").Value = Worksheets("VVS Installations").Cells(i, "H")
Me.Controls("TX_8").Value = Worksheets("VVS Installations").Cells(i, "I")
Me.Controls("TX_9").Value = Worksheets("VVS Installations").Cells(i, "J")
Me.Controls("TX_10").Value = Worksheets("VVS Installations").Cells(i, "K")
Me.Controls("TX_DATE_ATTENDED") = Worksheets("VVS Installations").Cells(i, "L")
Me.Controls("TX_NVR_QTY").Value = 1
Me.Controls("TX_SWITCH_QTY").Value = 1
Me.Controls("TX_SURGE_QTY").Value = 3
Me.Controls("TX_UNABLE_TO_INSTALL_MAINTAIN").Value = "NO"
Me.Controls("TX_DOME_CAM_QTY").Value = Worksheets("VVS Installations").Cells(i, "N")
Me.Controls("TX_TEAM").Value = Worksheets("VVS Installations").Cells(i, "O")
Me.Controls("TX_BULLET_CAM_QTY").Value = Worksheets("VVS Installations").Cells(i, "R")
Me.Controls("TX_IP_RANGE_START").Value = Worksheets("VVS Installations").Cells(i, "T")
Me.Controls("TX_GATEWAY").Value = Worksheets("VVS Installations").Cells(i, "U")
Me.Controls("TX_CTN_PORT").Value = Worksheets("VVS Installations").Cells(i, "W")
Me.Controls("TX_PLATFORM").Value = Worksheets("VVS Installations").Cells(i, "X")
Me.Controls("TX_SITE_LIVE_DD").Value = Worksheets("VVS Installations").Cells(i, "Y")
Me.Controls("TX_SITE_VANDALIZED").Value = Worksheets("VVS Installations").Cells(i, "Z")
Me.Controls("TX_COMMENT").Value = Worksheets("VVS Installations").Cells(i, "AA")
MsgBox "The site has already been installed with Container and Tower Cameras. Please use maintenance to update the site Details."
Me.TX_SITE_ID_CHECK = "Exist"
Exit Sub
ElseIf Sheets("VVS Installations").Cells(x, "B") = Me.TX_1.Value And Sheets("VVS Installations").Cells(x, "N") = 1 _
And Sheets("VVS Installations").Cells(x, "R") = 0 Then
Me.Controls("TX_1").Value = Worksheets("VVS Installations").Cells(i, "B")
Me.Controls("TX_2").Value = Worksheets("VVS Installations").Cells(i, "C")
Me.Controls("TX_3").Value = Worksheets("VVS Installations").Cells(i, "D")
Me.Controls("TX_4").Value = Worksheets("VVS Installations").Cells(i, "E")
Me.Controls("TX_5").Value = Worksheets("VVS Installations").Cells(i, "F")
Me.Controls("TX_6").Value = Worksheets("VVS Installations").Cells(i, "G")
Me.Controls("TX_7").Value = Worksheets("VVS Installations").Cells(i, "H")
Me.Controls("TX_8").Value = Worksheets("VVS Installations").Cells(i, "I")
Me.Controls("TX_9").Value = Worksheets("VVS Installations").Cells(i, "J")
Me.Controls("TX_10").Value = Worksheets("VVS Installations").Cells(i, "K")
Me.Controls("TX_DATE_ATTENDED") = Worksheets("VVS Installations").Cells(i, "L")
Me.Controls("TX_NVR_QTY").Value = 1
Me.Controls("TX_SWITCH_QTY").Value = 1
Me.Controls("TX_SURGE_QTY").Value = 0
Me.Controls("TX_UNABLE_TO_INSTALL_MAINTAIN").Value = "NO"
Me.Controls("TX_DOME_CAM_QTY").Value = Worksheets("VVS Installations").Cells(i, "N")
Me.Controls("TX_TEAM").Value = Worksheets("VVS Installations").Cells(i, "O")
Me.Controls("TX_BULLET_CAM_QTY").Value = Worksheets("VVS Installations").Cells(i, "R")
Me.Controls("TX_IP_RANGE_START").Value = Worksheets("VVS Installations").Cells(i, "T")
Me.Controls("TX_GATEWAY").Value = Worksheets("VVS Installations").Cells(i, "U")
Me.Controls("TX_CTN_PORT").Value = Worksheets("VVS Installations").Cells(i, "W")
Me.Controls("TX_PLATFORM").Value = Worksheets("VVS Installations").Cells(i, "X")
Me.Controls("TX_SITE_LIVE_DD").Value = Worksheets("VVS Installations").Cells(i, "Y")
Me.Controls("TX_SITE_VANDALIZED").Value = Worksheets("VVS Installations").Cells(i, "Z")
Me.Controls("TX_COMMENT").Value = Worksheets("VVS Installations").Cells(i, "AA")
MsgBox "The site has Container Camera installed."
Me.TX_SITE_ID_CHECK = "Exist"
Exit Sub
Else
MsgBox "There is no record for an installation on the given Site ID"
Me.TX_SITE_ID_CHECK = "Valid"
Exit Sub
End If
Else
MsgBox "No Site ID Entered"
Exit Sub
End If
Else
MsgBox " Please select a Feedback type."
Exit Sub
End If
Next i
Next x
End SubSub InsertCopyRow()
Set rng = ActiveCell
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="nro!!!"
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
ActiveCell.FormulaR1C1 = "ENTER REF #"
ActiveSheet.Protect Password:="nro!!!", AllowFormattingCells:=True
Application.ScreenUpdating = True
End SubSub Send_Email()
Dim myApp As Object
Dim NewEmail As Object
Dim mySyncObjects As Object
Dim ItemCounter As Long
Set myApp = CreateObject("Outlook.Application")
Set NewEmail = myApp.CreateItem(0)
With NewEmail
.To = "email address" 'Note, address format modified due to posting rules
.Subject = "Test Email"
.Body = "Blah, blah, blah"
.DeleteAfterSubmit = True
.send
End With
'-----------------------------------------------------------------------------------
'STEP 3: Initiate Send/Receive
Set mySyncObjects = myApp.GetNamespace("MAPI").SyncObjects
For ItemCounter = 1 To mySyncObjects.Count
mySyncObjects.Item(ItemCounter).Start
Next
'-----------------------------------------------------------------------------------
End SubSub test_1()
'Copy a file
FileCopy "O:\EMV FDV\Oljet trehåndløper\HMS_Datablad_Liberon.pdf", "C:\Users\Geir Olav\Desktop\TestFDV\HMS_Datablad_Liberon.pdf"
End SubOption Explicit
Sub AutoSaveBook1()
Application.OnTime TimeValue("06:30:00"), "SaveBook1", TimeValue("06:30:30"), schedule:=True
End Sub
Sub SaveBook1()
ActiveWorkbook.SaveAs "M:\Coating Public\Line 4 Preventative Maintenance Files\Line 4 PM Entry Historical Data\Line 4 PM Entry " & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsm"
End Sub
Sub AutoSaveBook2()
Application.OnTime TimeValue("18:30:00"), "SaveBook2", TimeValue("18:30:30"), schedule:=True
End Sub
Sub SaveBook2()
ActiveWorkbook.SaveAs "M:\Coating Public\Line 4 Preventative Maintenance Files\Line 4 PM Entry Historical Data - " & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsm"
End Sub'---------------------------------------'
'-----Declaring Global Variables-----'
'---------------------------------------'
Option Explicit
Dim CurrentProgress As Double
Dim ProgressPercentage As Double
Dim BarWidth As Long
Dim StartingTime As Single
Dim IterateAgain As Double
'-----------------------------------'
'-----Optimal Savings Macro-----'
'-----------------------------------'
Sub OptimalSavingsCalc()
StartingTime = Timer
Call InitProgressBar
SavingsAnalysis "OptOnThresh", "OptOffThresh", "OptESUGoalSeek", "OptSOCGoalSeek", "ESS_Power_Savings", "ESSPower", "ESSCap", "NeededThresh", "Opt"
ProgressUpdate (0.01)
End Sub
'--------------------------------------'
'-----Progress Bar Initialization-----'
'--------------------------------------'
Sub InitProgressBar()
CurrentProgress = 0
IterateAgain = 0
Progress.StartUpPosition = 0
Progress.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Progress.Width)
Progress.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Progress.Height)
With Progress
.Bar.Width = 0
.Text.Caption = "0% Complete"
.Time.Caption = "Time Elapsed: 00:00:00"
.Show vbModeless
End With
End Sub
'--------------------------------'
'-----Progress Bar Update-----'
'--------------------------------'
Sub ProgressUpdate(Percentage)
CurrentProgress = CurrentProgress + Percentage
BarWidth = Progress.Border.Width * CurrentProgress
ProgressPercentage = Round(CurrentProgress * 100, 0)
Progress.Bar.Width = BarWidth
Progress.Time.Caption = "Time Elapsed: " & Format((Timer - StartingTime) / 86400, "hh:mm:ss")
Progress.Text.Caption = ProgressPercentage & "% Complete"
DoEvents
End SubPrivate Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("C2:C8")
If Not Intersect(Xrg, Range("C2:C8")) Is Nothing Then
Macro1
End If
End SubPrivate Sub Worksheet_Change(ByVal target As Range)
Dim KeyCells As Range
Set KeyCells = Worksheets("Sheet2").Range("Inputs")
If Not Application.Intersect(KeyCells, Range(target.Address)) Is Nothing Then
Worksheets("Sheet2").Calculate
End If
End SubPublic Function doThisThing(ByVal target As Range) As Variant
If target.Value2 < 50 Then
doThisThing = Worksheets("Sheet2").Cells(3, 2).Value * WorksheetFunction.Index(Worksheets("Sheet2").Range("Options"), 2, 2)
Else
doThisThing = Worksheets("Sheet2").Cells(3, 2).Value * WorksheetFunction.Index(Worksheets("Sheet2").Range("Options"), 3, 2)
End If
End Function| A | B | C | D | E | F | |
| 1 | Name | Number | Location | Ordered date | Effective Date | Due (Eff+2 days) |
| 2 | Doe, John | 12345 | West Hall | 1/22/2020 | 1/26/2020 | 1/28/2020 |
| 3 | Doe, Jane | 56789 | Triaging | 1/22/2020 | 1/26/2020 | 1/28/2020 |
Sub FilterApple()
ActiveSheet.Range("B2:F21").AutoFilter Field:=4, Criteria1:="1"
End Sub Private Sub CommandButton1_Click()
If CheckBoxApples = True Then Call FilterApples
End SubOption Explicit
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
' Posted by Myrna Larson
' July 25, 2000
' Microsoft.Public.Excel.Misc
' Subject: Combin
'
'
'Since you asked, here it is. It is generic, i.e. it isn't written specifically
'for a given population and set size, as yours it. It will do permutations or
'combinations. It uses a recursive routine to generate the subsets, one routine
'for combinations, a different one for permutations.
'To use it, you put the letter C or P (for combinations or permutations) in a
'cell. The cell below that contains the number of items in a subset. The Cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.
'You select the top cell, or the entire range and run the sub. The subsets are
'written to a new sheet in the workbook.
'
'
Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If
PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError
SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError
Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
' If N > Cells.Count Then GoTo DataError
If N > Cells.CountLarge Then GoTo DataError
Application.ScreenUpdating = False
Set Results = Worksheets.Add
vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0
If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0
Application.ScreenUpdating = True
Exit Sub
DataError:
If N = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells. " _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the number " _
& "of items in a subset, the cells below are the values from which " _
& "the subset is to be chosen."
Else
Which = "This requires " & Format$(N, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)
Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer
If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If
For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i
If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If
End Sub 'AddPermutation
Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)
Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer
If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If
For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i
If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If
End Sub 'AddCombination
Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)
Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long
If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1
If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If
Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If
BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If
End If
'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i
'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation
