ron
04-09-2009, 01:37 PM
Hi,
The below code loops thought all sheets in a workbook and creates a link to specific cells in the sheets. The links are created in a sheet named Index. Each sheet’s values will be on a row in the Index sheet. If the user has not entered a value in one of the cells the link is still created thereby displaying a value on the Index sheet when the user makes an entry on one of the sheet’s corresponding cells.
The cells formatted as a date display the value 1/0/1900 when the corresponding cell is blank. How can I alter my code so no date is displayed on the Index sheet if the user does not enter a date in the corresponding cell but the link remains?
I posted my question on another forum but did not receive a workable solution. http://www.mrexcel.com/forum/showthread.php?t=380021 (http://www.mrexcel.com/forum/showthread.php?t=380021)
Thanks
Ron
Sub Index_Create()
'creates Index with links to fields in each BOE sheet
Dim WB As Workbook
Dim ws As Worksheet
Dim i As Long
Dim rCount As Long
Dim CurSheet As String
On Error Resume Next
Application.ScreenUpdating = False
Set WB = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("Index")
'row count starts on row 5 on the sheet Index
rCount = 5
'Clear Index sheet cells
ws.Rows("5:5000").Delete
'format cells in Index sheet to not show zeros when linked cell is blank
ws.Range("A5:I1000").NumberFormat = "0;-0;;@"
'loop though sheets and copy links
For i = Sheets("Index").Index + 1 To WB.Sheets.Count
Sheets(i).Select
CurSheet = ActiveSheet.Name
With WB.Sheets("Index")
.Cells(rCount, 1).Formula = "='" & CurSheet & "'!" & "$B$2" 'BOE #
.Cells(rCount, 3).Formula = "='" & CurSheet & "'!" & "$D$2" 'Task ID
.Cells(rCount, 4).Formula = "='" & CurSheet & "'!" & "$B$5" 'Resource ID
.Cells(rCount, 5).Formula = "='" & CurSheet & "'!" & "$E$5" 'Skill
.Cells(rCount, 6).Formula = "='" & CurSheet & "'!" & "$D$3" 'CLIN
.Cells(rCount, 7).Formula = "='" & CurSheet & "'!" & "$B$3" 'WBS
.Cells(rCount, 8).Formula = "='" & CurSheet & "'!" & "$B$4" 'Description
.Cells(rCount, 9).Formula = "='" & CurSheet & "'!" & "$B$7" 'Start date
.Cells(rCount, 10).Formula = "='" & CurSheet & "'!" & "$D$7" 'End date
End With
rCount = rCount + 1
Next i
Application.ScreenUpdating = True
MsgBox "Index Created/Updated.", vbInformation, "Excel BOE"
End Sub
The below code loops thought all sheets in a workbook and creates a link to specific cells in the sheets. The links are created in a sheet named Index. Each sheet’s values will be on a row in the Index sheet. If the user has not entered a value in one of the cells the link is still created thereby displaying a value on the Index sheet when the user makes an entry on one of the sheet’s corresponding cells.
The cells formatted as a date display the value 1/0/1900 when the corresponding cell is blank. How can I alter my code so no date is displayed on the Index sheet if the user does not enter a date in the corresponding cell but the link remains?
I posted my question on another forum but did not receive a workable solution. http://www.mrexcel.com/forum/showthread.php?t=380021 (http://www.mrexcel.com/forum/showthread.php?t=380021)
Thanks
Ron
Sub Index_Create()
'creates Index with links to fields in each BOE sheet
Dim WB As Workbook
Dim ws As Worksheet
Dim i As Long
Dim rCount As Long
Dim CurSheet As String
On Error Resume Next
Application.ScreenUpdating = False
Set WB = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("Index")
'row count starts on row 5 on the sheet Index
rCount = 5
'Clear Index sheet cells
ws.Rows("5:5000").Delete
'format cells in Index sheet to not show zeros when linked cell is blank
ws.Range("A5:I1000").NumberFormat = "0;-0;;@"
'loop though sheets and copy links
For i = Sheets("Index").Index + 1 To WB.Sheets.Count
Sheets(i).Select
CurSheet = ActiveSheet.Name
With WB.Sheets("Index")
.Cells(rCount, 1).Formula = "='" & CurSheet & "'!" & "$B$2" 'BOE #
.Cells(rCount, 3).Formula = "='" & CurSheet & "'!" & "$D$2" 'Task ID
.Cells(rCount, 4).Formula = "='" & CurSheet & "'!" & "$B$5" 'Resource ID
.Cells(rCount, 5).Formula = "='" & CurSheet & "'!" & "$E$5" 'Skill
.Cells(rCount, 6).Formula = "='" & CurSheet & "'!" & "$D$3" 'CLIN
.Cells(rCount, 7).Formula = "='" & CurSheet & "'!" & "$B$3" 'WBS
.Cells(rCount, 8).Formula = "='" & CurSheet & "'!" & "$B$4" 'Description
.Cells(rCount, 9).Formula = "='" & CurSheet & "'!" & "$B$7" 'Start date
.Cells(rCount, 10).Formula = "='" & CurSheet & "'!" & "$D$7" 'End date
End With
rCount = rCount + 1
Next i
Application.ScreenUpdating = True
MsgBox "Index Created/Updated.", vbInformation, "Excel BOE"
End Sub