select workbook to update

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top