Sub room(colc, rowc, w)
If colc >= 221 And rowc >= 64001 Then
w = w + 1
Set wsc = Worksheets(w)
colc = 1
rowc = 2
End If
If rowc >= 64001 Then
colc = colc + 20
rowc = 2
End If
End Sub
Public Sub cmdOK_Click()
Dim data(1, 1, 1, 1, 1, 1, 1, 1, 1) As String
'(Equipment Tag, Delivery date, maint freq, required maintaince, Maintance Date, notes, completed?,description,maint instruc)
Dim a As Integer ' Array variables
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim j As Integer
Dim extra As Date ' holds values for array while switching parts (used for calculating days from freq)
Dim dd As Date 'Delivery date
Dim rowSS(1000) As Integer
Dim tag As String
Dim w As Integer
Dim Show_Box As Boolean
Dim DDate As Variant
Dim row As Integer
Dim col As Integer
Dim flag As Integer
Dim ws As Worksheet ' reading from this sheet
'writing from this sheet
Dim wsl As Worksheet
Dim rowc As Double 'row being writting to
Dim gcol As Integer 'col grabing data
Dim Tcol As Integer 'col tag numbers are reading from
Dim fcol As Integer
Dim dcol As Integer
Dim rcol As Integer
Dim mcol As Integer
Dim ncol As Integer
Dim ccol As Integer
Dim Notes As String
Dim check As Integer
Dim listt(200000) As String
Dim p As Integer
Dim rowl As Integer
Dim index As Integer ' which alt- enter (counting down from top)
Dim place As Integer 'Placement of the line break (alt - enter)
Dim plholder As Integer ' takes the place value at end of loop
Dim cell As String 'Data in cell (changes every loop)
Dim distance As Integer 'distance from one alt-enter to another
Dim length As Integer 'length of all contents in cell (length of cell string)
Dim LPflag(30) As String 'For the exceptions where the cells don't match up
Dim i As Double 'clears the array
Dim colc As Integer
Dim TTags As Integer 'Total amount of Tags on list
Dim resp As Integer
Dim today As Date
Dim rowp As Integer
Dim rowd As Double
Dim cold As Double
Dim daycheck As Integer
Dim wsc As Worksheet 'Data base sheets. Fills to 65000 collums then moves over by 20 collums
Dim yearl As Long
Dim year(1) As Double
Dim monthl As Long
Dim weekl As Long
Dim dayl As Long
Dim month(1) As Double
Dim week(1) As Double
Dim day(1) As Double
Dim OT As Long
If listWorksheet.listIndex = -1 Then
MsgBox ("Please Select the Worksheets")
Exit Sub
End If
Set ws = Worksheets(listWorksheet.list(listWorksheet.listIndex))
Set wsl = Worksheets("List")
Dim intervall As String
today = Date
p = 0
Tcol = 3
fcol = 10
dcol = 12
rcol = 9
mcol = 13 'CHANGE
ncol = 14
ccol = 15
ddcol = 2
Password = "Default"
check = 0
flag = 1
col = 12
DDate = 1
tag = "1"
rowc = 1
gcol = 1
resp = 1
rowl = 1
frmEquip.listEquip.Clear
frmEquip.listEquip2.Clear
Do
If wsl.cells(rowl, 1) = "" Then
TTags = rowl
Exit Do
Else
rowl = rowl + 1
End If
Loop While rowl < 8000 'Changable
rowl = 1
'*********Getting Date Input from User**************************************
DDate = txtDate.Value
If DDate = "" Then
MsgBox ("You did not enter any date, please try again")
Exit Sub
Else ' Test Entry to find out if it is numeric.
If IsDate(DDate) = True Then
ElseIf StrComp(DDate, "None", 3) = 0 Then
Else
MsgBox ("Error - Could not read the Date, please try again")
Exit Sub
End If
End If
'****************************Getting Tag number from user*********************************
tag = txtTagNum.Value
If tag = "" Then
MsgBox ("You did not enter any tag number")
Exit Sub
End If
'*****************Adding Tag number to list*************
row = 2
If tag = "all" Then
Do
listt(p) = ws.cells(row, 3)
frmEquip.listEquip2.AddItem (listt(p))
row = row + 1
Loop While ws.cells(row, 3) <> ""
flag = 0
Else
Do
If StrComp(tag, ws.cells(row, 3), 1) = 0 Then
listt(p) = ws.cells(row, 3)
flag = 0
rowl = 1
a = 1
Do
If StrComp(ws.cells(row, 3), wsl.cells(rowl, 1)) = 0 Then
frmEquip.listEquip.AddItem (listt(p)) ' & " Already Delivered")
a = 0
Exit Do
End If
rowl = rowl + 1
Loop While rowl <= TTags
If a = 1 Then
frmEquip.listEquip.AddItem (listt(p))
End If
p = p + 1
ElseIf InStr(1, ws.cells(row, 3), tag, 1) > 0 Then
listt(p) = ws.cells(row, 3)
flag = 0
rowl = 1
a = 1
Do
If StrComp(ws.cells(row, 3), wsl.cells(rowl, 1)) = 0 Then
frmEquip.listEquip.AddItem (listt(p)) ' & " ALREADY DELIVERED!!")
a = 0
'frmEquip.listEquip.Font.Bold = False
Exit Do
End If
rowl = rowl + 1
Loop While rowl <= TTags
If a = 1 Then
frmEquip.listEquip.AddItem (listt(p))
End If
p = p + 1
End If
row = row + 1
Loop While row < 1500 ' may want user to change
End If
If flag = 1 Then
tag = MsgBox("Could not find the equipment searched for.")
Exit Sub
End If
frmEquip.Show
If frmEquip.lblclose.Caption = "close" Then
frmEquip.lblclose.Caption = ""
Exit Sub
End If
p = 0
Password = "Wrong"
Do
listt(i) = 0
i = i + 1
Loop While i < 200001
'*****Getting data from second list*******
Do
listt(p) = frmEquip.listEquip2.list(p)
p = p + 1
Loop While p < frmEquip.listEquip2.ListCount
p = 0
Do
flag = 0
row = 1
Do '**** Finding Tag on orginal list ***********
If StrComp(listt(p), ws.cells(row, 3), 1) = 0 Then
Exit Do
Else
row = row + 1
End If
Loop While row < 11000
'**************** Checking if its been done before**** Make a note come up if it has
If rowp > TTags Then
Exit Do
End If
rowl = 1
Do
If StrComp(listt(p), wsl.cells(rowl, 1), vbTextCompare) = 0 And wsl.cells(rowl, 5) <> "Deleted" Then
rowc = wsl.cells(rowl, 3)
colc = wsl.cells(rowl, 4)
w = wsl.cells(rowl, 2)
Set wsc = Worksheets(w)
flag = 4 'Means its already on list
Exit Do
ElseIf StrComp(listt(p), wsl.cells(rowl, 1), vbTextCompare) = 0 Then
If wsl.cells(rowl, 9) = "yes" And DDate = "Now" Then
MsgBox ("The PM has Already been stoped for this Equipment by the STOP/START PM Button on the Main Menu")
Exit Sub
End If
End If
rowl = rowl + 1
Loop While rowl <= 12000
If flag = 0 Then 'was not found on already added list
rowc = wsl.cells(TTags - 1, 3)
colc = wsl.cells(TTags - 1, 4)
w = wsl.cells(TTags - 1, 2)
Set wsc = Worksheets(w)
If DDate = "None" Then
MsgBox ("You cannot enter None for the date of Equipment that has not started PM yes")
Exit Sub
End If
Else ' was found on the already added list
If Password <> "Shaun" Then
resp = MsgBox("IMPORTANT - Some or all the Tag numbers you selected or entered have had PM Start already for them, if you change the PM Start Date, all non-completed work will be DELETED!. ARE YOU SURE YOU WANT TO CONTINUE?", 4, "WARNING")
If resp = 7 Then
Exit Sub
End If
Do
Password = InputBox("Please Enter the Password")
If Password = "Shaun" Then
MsgBox ("Correct Password")
Exit Do
Else
resp = MsgBox("Wrong password, do you want to try again?", 4)
If resp = 7 Then
Exit Sub
End If
End If
Loop
End If
'*******Checking if theres room left on worksheet****
Do
If wsc.cells(rowc, 7) <> "yes" Then
gcol = 2
Do
wsc.cells(rowc, gcol - 1 + colc) = "Deleted"
gcol = gcol + 1
Loop While gcol <= 20
End If
rowc = rowc + 1
Call room(colc, rowc, w)
Loop While StrComp(listt(p), wsc.cells(rowc, 1)) = 0
rowc = wsl.cells(TTags - 1, 3)
colc = wsl.cells(TTags - 1, 4)
w = wsl.cells(TTags - 1, 4)
Set wsc = Worksheets(w)
wsl.cells(rowl, 5) = "Deleted"
wsl.cells(rowl, 8) = Date
If DDate = "None" Then
Exit Sub
End If
End If
Do
If wsc.cells(rowc, colc) = "" Then
Exit Do
End If
rowc = rowc + 1
Call room(colc, rowc, w)
Loop
rowl = TTags
a = 0
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
h = 0
j = 0
Notes = txtNotes.Value
'*********************Getting data from orginial worksheet***********
'*** TaG***
a = 1
data(a, b, c, d, e, f, g, h, j) = ws.cells(row, Tcol)
a = 1
'***** Delivery Date*******
b = 1
data(a, b, c, d, e, f, g, h, j) = DDate
'maintaince freq
c = 1
'maintaince required
d = 1
'maintaince dates
e = 1
'Notes
f = 1
data(a, b, c, d, e, f, g, h, j) = Notes
'Completed??
g = 1
h = 1
data(a, b, c, d, e, f, g, h, j) = ws.cells(row, 4)
j = 1
data(a, b, c, d, e, f, g, h, j) = ws.cells(row, 11)
'******* Getting Maintaince freq/required **********
plholder = 0
plholderh = 0
flag = 9
Do 'Sorting through Alt-Enters **********************************
LPlace = 0
cell = ws.cells(row, fcol)
index = 1
If cell <> "" Then
Do
If wsc.cells(rowc, colc) = "" Then
Exit Do
End If
rowc = rowc + 1
Loop While rowc <= 64000
Call room(colc, rowc, w)
If flag = 9 Then
wsl.cells(rowl, 1) = data(1, 0, 0, 0, 0, 0, 0, 0, 0)
wsl.cells(rowl, 2) = w
wsl.cells(rowl, 3) = rowc
wsl.cells(rowl, 4) = colc
wsl.cells(rowl, 6) = data(1, 1, 0, 0, 0, 0, 0, 0, 0)
wsl.cells(rowl, 7) = today
flag = 10
TTags = TTags + 1
End If
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
h = 0
j = 0
gcol = colc
wsc.cells(rowc, gcol) = data(a, b, c, d, e, f, g, h, j)
b = 1
gcol = 1 + colc
wsc.cells(rowc, gcol) = data(a, b, c, d, e, f, g, h, j)
c = 1
d = 1
gcol = 3 + colc
e = 1
f = 1
gcol = 5 + colc
wsc.cells(rowc, gcol) = data(a, b, c, d, e, f, g, h, j)
g = 1
h = 1
gcol = 7 + colc
wsc.cells(rowc, gcol) = data(a, b, c, d, e, f, g, h, j)
j = 1
gcol = 10 + colc
wsc.cells(rowc, gcol) = data(a, b, c, d, e, f, g, h, j)
a = 1
b = 1
c = 1
d = 0
e = 0
f = 0
g = 0
h = 0
j = 0
gcol = 3
i = 1
Do '*** Getting Freq****
LPflag(i) = 0
i = i + 1
Loop While i < 31
length = Len(cell)
place = InStr(plholder + 1, cell, Chr(10), 1)
distance = place - plholder
If distance <= 0 Then
data(a, b, c, d, e, f, g, h, j) = Mid(cell, plholder + 1, length)
data(a, b, c, d, e, f, g, h, j) = Trim(data(a, b, c, d, e, f, g, h, j))
Else
data(a, b, c, d, e, f, g, h, j) = Mid(cell, plholder + 1, distance - 1)
data(a, b, c, d, e, f, g, h, j) = Trim(data(a, b, c, d, e, f, g, h, j))
End If
check = place
'*** Getting Maitaince req****
c = 1
d = 1
gcol = 4
cell = ws.cells(row, rcol)
length = Len(cell)
place = InStr(plholderh + 1, cell, Chr(10), 1)
distance = place - plholderh
If distance <= 0 Then
data(a, b, c, d, e, f, g, h, j) = Mid(cell, plholderh + 1, length)
data(a, b, c, d, e, f, g, h, j) = Trim(data(a, b, c, d, e, f, g, h, j))
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
Else
data(a, b, c, d, e, f, g, h, j) = Mid(cell, plholderh + 1, distance - 1)
data(a, b, c, d, e, f, g, h, j) = Trim(data(a, b, c, d, e, f, g, h, j))
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
End If
'** Checking special cases**
If data(a, b, c, d, e, f, g, h, j) = "IH" Then
LPflag(index) = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "I" Then
LPflag(index) = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "O" Then
LPflag(index) = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "OC" Then
LPflag(index) = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "SITE" Then
LPflag(index) = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "M" Then
LPflag(index) = 1
End If
If LPflag(index) = 1 Then
d = 0
gcol = 3
data(a, b, c, d, e, f, g, h, j) = "No data"
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
End If
d = 0
'Calculating Maintance days***
If data(a, b, c, d, e, f, g, h, j) = "Init'l" Then
wsc.cells(rowc, 2 + colc) = "Intial"
c = 0
extra = data(a, b, c, d, e, f, g, h, j)
c = 1
d = 1
e = 1
data(a, b, c, d, e, f, g, h, j) = extra
gcol = 5
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
Call DayList(rowc, colc, w, daycheck, extra)
'2 weeks*********************************
ElseIf data(a, b, c, d, e, f, g, h, j) = "Init l &@2WK" Or data(a, b, c, d, e, f, g, h, j) = "Intial" Then
c = 0
extra = data(a, b, c, d, e, f, g, h, j)
c = 1
d = 1
e = 1
data(a, b, c, d, e, f, g, h, j) = extra
wsc.cells(rowc, 2 + colc) = "Intial"
Call DayList(rowc, colc, w, daycheck, extra)
gcol = 5
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
extra = DateAdd("ww", 2, extra)
rowc = rowc + 1
Call room(colc, rowc, w)
wsc.cells(rowc, gcol - 1 + colc) = extra
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
h = 0
j = 0
gcol = 1
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
b = 1
gcol = 2
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
c = 1
gcol = 3
wsc.cells(rowc, gcol - 1 + colc) = "One Time @ 0 years 0 months 2 weeks 0 days"
d = 1
gcol = 4
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
e = 1
f = 1
gcol = 6
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
g = 1
h = 1
gcol = 8
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
j = 1
gcol = 11
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
Call DayList(rowc, colc, w, daycheck, extra)
f = 0
g = 0
h = 0
j = 0
ElseIf InStr(1, data(a, b, c, d, e, f, g, h, j), "One time @ ", vbTextCompare) > 0 Then
OTl = InStr(1, data(a, b, c, d, e, f, g, h, j), "One Time @ ", vbTextCompare)
yearl = InStr(1, data(a, b, c, d, e, f, g, h, j), " years", vbTextCompare)
year(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), 11, yearl - 11))
monthl = InStr(1, data(a, b, c, d, e, f, g, h, j), " months", vbTextCompare)
month(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), yearl + 6, monthl - yearl - 6))
weekl = InStr(1, data(a, b, c, d, e, f, g, h, j), " weeks", vbTextCompare)
week(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), monthl + 7, weekl - monthl - 7))
dayl = InStr(1, data(a, b, c, d, e, f, g, h, j), " days", vbTextCompare)
day(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), weekl + 7, dayl - weekl - 7))
extra = Date
extra = DateAdd("yyyy", year(1), extra)
extra = DateAdd("m", month(1), extra)
extra = DateAdd("ww", week(1), extra)
extra = DateAdd("d", day(1), extra)
wsc.cells(rowc, colc) = data(1, 0, 0, 0, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 1) = data(1, 1, 0, 0, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 2) = data(1, 1, 1, 0, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 3) = data(1, 1, 1, 1, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 4) = extra
wsc.cells(rowc, colc + 5) = data(1, 1, 1, 1, 1, 1, 0, 0, 0)
wsc.cells(rowc, colc + 7) = data(1, 1, 1, 1, 1, 1, 1, 1, 0)
wsc.cells(rowc, colc + 10) = data(1, 1, 1, 1, 1, 1, 1, 1, 1)
Call DayList(rowc, colc, w, daycheck, extra)
ElseIf InStr(1, data(a, b, c, d, e, f, g, h, j), " years", vbTextCompare) > 0 Then
yearl = InStr(1, data(a, b, c, d, e, f, g, h, j), " years", vbTextCompare)
year(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), 1, yearl))
monthl = InStr(1, data(a, b, c, d, e, f, g, h, j), " months", vbTextCompare)
month(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), yearl + 6, monthl - yearl - 6))
weekl = InStr(1, data(a, b, c, d, e, f, g, h, j), " weeks", vbTextCompare)
week(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), monthl + 7, weekl - monthl - 7))
dayl = InStr(1, data(a, b, c, d, e, f, g, h, j), " days", vbTextCompare)
day(1) = Trim(Mid(data(a, b, c, d, e, f, g, h, j), weekl + 7, dayl - weekl - 7))
extra = Date
Do
extra = DateAdd("yyyy", year(1), extra)
extra = DateAdd("m", month(1), extra)
extra = DateAdd("ww", week(1), extra)
extra = DateAdd("d", day(1), extra)
If extra <= "Jan 1 2014" Then
wsc.cells(rowc, colc) = data(1, 0, 0, 0, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 1) = data(1, 1, 0, 0, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 2) = data(1, 1, 1, 0, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 3) = data(1, 1, 1, 1, 0, 0, 0, 0, 0)
wsc.cells(rowc, colc + 4) = extra
wsc.cells(rowc, colc + 5) = data(1, 1, 1, 1, 1, 1, 0, 0, 0)
wsc.cells(rowc, colc + 7) = data(1, 1, 1, 1, 1, 1, 1, 1, 0)
wsc.cells(rowc, colc + 10) = data(1, 1, 1, 1, 1, 1, 1, 1, 1)
Call DayList(rowc, colc, w, daycheck, extra)
rowc = rowc + 1
Call room(colc, rowc, w)
End If
Loop While extra <= "Jan 1 2014"
Else
Dim interval As String
Dim amount As Integer
If data(a, b, c, d, e, f, g, h, j) = "2 Wk" Or data(a, b, c, d, e, f, g, h, j) = "2Weeks" Or data(a, b, c, d, e, f, g, h, j) = "2 Weeks" Or data(a, b, c, d, e, f, g, h, j) = "2 Wks" Or data(a, b, c, d, e, f, g, h, j) = "2wks" Then
wsc.cells(rowc, colc + 2) = "0 years 0 months 2 weeks 0 days"
intervall = "0 years 0 months 2 weeks 0 days"
interval = "ww"
amount = 1
ElseIf StrComp(data(a, b, c, d, e, f, g, h, j), "1 Mon", vbTextCompare) = 0 Or data(a, b, c, d, e, f, g, h, j) = "1 Mon." Then
wsc.cells(rowc, colc + 2) = "0 years 1 months 0 weeks 0 days"
intervall = "0 years 1 months 0 weeks 0 days"
interval = "m"
amount = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "2 Mon" Or data(a, b, c, d, e, f, g, h, j) = "2 Mons" Then
wsc.cells(rowc, colc + 2) = "0 years 3 months 0 weeks 0 days"
intervall = "0 years 3 months 0 weeks 0 days"
interval = "m"
amount = 1
ElseIf data(a, b, c, d, e, f, g, h, j) = "3 Mon" Or data(a, b, c, d, e, f, g, h, j) = "3 Mons" Then
wsc.cells(rowc, colc + 2) = "0 years 3 months 0 weeks 0 days"
interval = "m"
intervall = "0 years 3 months 0 weeks 0 days"
amount = 3
ElseIf data(a, b, c, d, e, f, g, h, j) = "No data" Then
Else
'MsgBox ("Missing date " & data(a, b, c, d, e, f, g, h, j))
End If
d = 0
c = 0
extra = data(a, b, c, d, e, f, g, h, j)
dd = extra
c = 1
d = 1
e = 1
Do
f = 0
g = 0
h = 0
j = 0
extra = DateAdd(interval, amount, extra)
data(a, b, c, d, e, f, g, h, j) = extra
gcol = 5
Call room(colc, rowc, w)
Call DayList(rowc, colc, w, daycheck, extra)
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
h = 0
j = 0
gcol = 1
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
b = 1
gcol = 2
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
c = 1
gcol = 3
wsc.cells(rowc, gcol - 1 + colc) = intervall
d = 1
gcol = 4
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
e = 1
f = 1
gcol = 6
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
g = 1
h = 1
gcol = 8
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
gcol = 11
j = 1
wsc.cells(rowc, gcol - 1 + colc) = data(a, b, c, d, e, f, g, h, j)
rowc = rowc + 1
Loop While extra < "Jan 1 2014" 'Something you might want user to change
End If
plholderh = place
If LPflag(index) <> 1 Then
plholder = check
End If
index = index + 1
End If
If cell = "" Then
Exit Do
End If
Loop While distance > 0
p = p + 1
Loop While p < frmEquip.listEquip2.ListCount
frmEquip.listEquip.Clear
frmEquip.listEquip2.Clear
frmDates.Hide
Worksheets("More then Seven").cells(9, 9) = Now
End Sub
Sub DayList(rowc, colc, w, daycheck, extra)
Dim rowd As Double
Dim cold As Double
Dim lastRow1 As Date
Dim lastRow2 As Date
Dim lastRow3 As Date
Dim flagg As Integer
Dim dws As Worksheet
Dim dws1 As Worksheet
Dim dws2 As Worksheet
Dim dws3 As Worksheet
Set dws1 = Worksheets("Day sheet 1")
Set dws2 = Worksheets("Day sheet 2")
Set dws3 = Worksheets("Day sheet 3")
lastRow1 = dws1.cells(63902, 1)
lastRow2 = dws2.cells(63902, 1)
lastRow3 = dws3.cells(63902, 1)
rowd = 2
cold = 2
flagg = 0
If extra > lastRow1 Then
If extra > lastRow2 Then
Set dws = dws3
Else
Set dws = dws2
End If
Else
Set dws = dws1
End If
If extra > lastRow3 Then
MsgBox ("Problem contact Shaun")
End If
Do
If dws.cells(rowd, 1) = extra Then
Do
If dws.cells(rowd, cold) = "" Then
dws.cells(rowd, cold) = w
cold = cold + 1
dws.cells(rowd, cold) = rowc
cold = cold + 1
dws.cells(rowd, cold) = colc
flagg = 1
Exit Do
Else
cold = cold + 1
If cold = 253 Then
rowd = rowd + 1
cold = 2
End If
End If
If rowd = 64000 Then
MsgBox ("Error")
End If
Loop
End If
rowd = rowd + 50
Loop While flagg = 0
End Sub
'Private Sub UserForm_Click()
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use a button!"
End If
End Sub
