select workbook to update
 

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
-------------------

--
milkshak
-----------------------------------------------------------------------
milkshake's Profile: http://www.excelforum.com/member.php...fo&userid=3195
View this thread: http://www.excelforum.com/showthread.php?threadid=51673

select workbook to update
 

Look at Excel VBA help on Application.GetOpenFileName()

--
Regards,
Tom Ogilvy


"milkshake" wrote
in message ...

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 a
different worksheet in the resource workbook. The resource workbook
might be placed in different paths and hence a select file dialog is
needed but I am not sure how. Here is my code, I have here opening the
resource workbook (facility worksheet) which is placed in the same
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 Sub
--------------------


--
milkshake
------------------------------------------------------------------------
milkshake's Profile:
http://www.excelforum.com/member.php...o&userid=31953
View this thread: http://www.excelforum.com/showthread...hreadid=516735

select workbook to update
 

Okay, thanks. :) I've found it

--
milkshak
-----------------------------------------------------------------------
milkshake's Profile: http://www.excelforum.com/member.php...fo&userid=3195
View this thread: http://www.excelforum.com/showthread.php?threadid=51673