M
milkshake
Hi all,
I need here to select a resource file to update, in this resource file
there are 3 worksheets and I've 2 sub routines and each has to update
different worksheet in the resource workbook. The resource workboo
might be placed in different paths and hence a select file dialog i
needed but I am not sure how. Here is my code, I have here opening th
resource workbook (facility worksheet) which is placed in the sam
folder as the one with this sub routine. Please help. Thank you.
Code
-------------------
Sub facility()
Dim venue(200) As String
Dim daytext(100) As String
Dim stime(100) As String
Dim etime(100) As String
Dim daynr(100) As Integer
Dim stimecol(100) As Integer
Dim etimecol(100) As Integer
lrow = Cells(Rows.Count, "K").End(xlUp).Row
j = 1
For i = 7 To lrow
If Cells(i, "K") <> Cells(i + 1, "K") Then
If Cells(i + 1, "K") <> "" Then
venue(j) = Cells(i + 1, "K")
daytext(j) = Cells(i + 1, "B")
stime(j) = Cells(i + 1, "C")
etime(j) = Cells(i + 1, "D")
j = j + 1
End If
End If
Next i
grpnr = j - 1
For i = 1 To grpnr
Select Case daytext(i)
Case "Mon"
daynr(i) = 3
Case "Tue"
daynr(i) = 18
Case "Wed"
daynr(i) = 33
Case "Thu"
daynr(i) = 48
Case "Fri"
daynr(i) = 63
Case "Sat"
daynr(i) = 78
Case Else
MsgBox "Error in Day"
End Select
Select Case stime(i)
Case "0800"
stimecol(i) = 1
Case "0900"
stimecol(i) = 2
Case "1010"
stimecol(i) = 3
Case "1100"
stimecol(i) = 4
Case "1205"
stimecol(i) = 5
Case "1300"
stimecol(i) = 6
Case "1400"
stimecol(i) = 7
Case "1510"
stimecol(i) = 8
Case "1610"
stimecol(i) = 9
Case "1710"
stimecol(i) = 10
End Select
Select Case etime(i)
Case "0850"
etimecol(i) = 1
Case "0950"
etimecol(i) = 2
Case "1100"
etimecol(i) = 3
Case "1200"
etimecol(i) = 4
Case "1255"
etimecol(i) = 5
Case "1350"
etimecol(i) = 6
Case "1450"
etimecol(i) = 7
Case "1600"
etimecol(i) = 8
Case "1700"
etimecol(i) = 9
Case "1800"
etimecol(i) = 10
End Select
Next i
Application.ScreenUpdating = False
Workbooks.Open (ActiveWorkbook.Path & "\ResourcesBlockTime.xls")
Sheets("Facility_BU").Select
lrow = Cells(Rows.Count, "B").End(xlUp).Row
For j = 9 To lrow
Range("A" & j) = Range("B" & j)
Next j
For j = lrow To 9 Step -1
If Range("A" & j) <> Range("A" & j - 1) Then
End If
Next j
For i = 1 To grpnr
Debug.Print venue(i), daynr(i), stime(i), etime(i)
rownr = Columns(1).Find(venue(i)).Row
lrow = Cells(rownr, 1).End(xlDown).Row
nrofrows = lrow - rownr + 1
Intersect(Rows(rownr), Cells(rownr, daynr(i) + stimecol(i))) = 1
Intersect(Rows(rownr), Cells(rownr, daynr(i) + etimecol(i))) = 1
Next i
lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lrow To 9 Step -1
If Cells(i, 1) = "" Then Rows(i).Delete
Next i
Columns(1).ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
MsgBox "Facility updated"
End Su
I need here to select a resource file to update, in this resource file
there are 3 worksheets and I've 2 sub routines and each has to update
different worksheet in the resource workbook. The resource workboo
might be placed in different paths and hence a select file dialog i
needed but I am not sure how. Here is my code, I have here opening th
resource workbook (facility worksheet) which is placed in the sam
folder as the one with this sub routine. Please help. Thank you.
Code
-------------------
Sub facility()
Dim venue(200) As String
Dim daytext(100) As String
Dim stime(100) As String
Dim etime(100) As String
Dim daynr(100) As Integer
Dim stimecol(100) As Integer
Dim etimecol(100) As Integer
lrow = Cells(Rows.Count, "K").End(xlUp).Row
j = 1
For i = 7 To lrow
If Cells(i, "K") <> Cells(i + 1, "K") Then
If Cells(i + 1, "K") <> "" Then
venue(j) = Cells(i + 1, "K")
daytext(j) = Cells(i + 1, "B")
stime(j) = Cells(i + 1, "C")
etime(j) = Cells(i + 1, "D")
j = j + 1
End If
End If
Next i
grpnr = j - 1
For i = 1 To grpnr
Select Case daytext(i)
Case "Mon"
daynr(i) = 3
Case "Tue"
daynr(i) = 18
Case "Wed"
daynr(i) = 33
Case "Thu"
daynr(i) = 48
Case "Fri"
daynr(i) = 63
Case "Sat"
daynr(i) = 78
Case Else
MsgBox "Error in Day"
End Select
Select Case stime(i)
Case "0800"
stimecol(i) = 1
Case "0900"
stimecol(i) = 2
Case "1010"
stimecol(i) = 3
Case "1100"
stimecol(i) = 4
Case "1205"
stimecol(i) = 5
Case "1300"
stimecol(i) = 6
Case "1400"
stimecol(i) = 7
Case "1510"
stimecol(i) = 8
Case "1610"
stimecol(i) = 9
Case "1710"
stimecol(i) = 10
End Select
Select Case etime(i)
Case "0850"
etimecol(i) = 1
Case "0950"
etimecol(i) = 2
Case "1100"
etimecol(i) = 3
Case "1200"
etimecol(i) = 4
Case "1255"
etimecol(i) = 5
Case "1350"
etimecol(i) = 6
Case "1450"
etimecol(i) = 7
Case "1600"
etimecol(i) = 8
Case "1700"
etimecol(i) = 9
Case "1800"
etimecol(i) = 10
End Select
Next i
Application.ScreenUpdating = False
Workbooks.Open (ActiveWorkbook.Path & "\ResourcesBlockTime.xls")
Sheets("Facility_BU").Select
lrow = Cells(Rows.Count, "B").End(xlUp).Row
For j = 9 To lrow
Range("A" & j) = Range("B" & j)
Next j
For j = lrow To 9 Step -1
If Range("A" & j) <> Range("A" & j - 1) Then
End If
Next j
For i = 1 To grpnr
Debug.Print venue(i), daynr(i), stime(i), etime(i)
rownr = Columns(1).Find(venue(i)).Row
lrow = Cells(rownr, 1).End(xlDown).Row
nrofrows = lrow - rownr + 1
Intersect(Rows(rownr), Cells(rownr, daynr(i) + stimecol(i))) = 1
Intersect(Rows(rownr), Cells(rownr, daynr(i) + etimecol(i))) = 1
Next i
lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lrow To 9 Step -1
If Cells(i, 1) = "" Then Rows(i).Delete
Next i
Columns(1).ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
MsgBox "Facility updated"
End Su