Referring to same cells in all worksheets
 

Below is code I cobbled together to loop through all worksheets and collect
the values from cell K3 into an array and write that array to a worksheet.
Issues I am asking help on:

1. I realize this will break if a column or row is added to move my cell A5
to new address. What can I do to accommodate the possibility of rows or
columns being added to alter location of value in K3? This workbook has
about 100 worksheets. Additional worksheets may be added at any time by
unsophisticated users.

2.This code is run by a command button only on worksheet named
"4.StatusRullup" but I would like the code to tolerate a re-naming of the
worksheet. Is worksheet number a permanent attribute that doesn't chnge even
when worksheets are added or re-arranged? How do I refer to a worksheet in
VBA by number rather than name?

Any other suggestions to my cobbled-together stuff here are certainly
welcome. Once I get these issues resolved I will be altering this to take
values from 6 cells on each worksheet for status rollup.
------------------------
Sub StatusSummary()
' Fill a range on Status Summary Worksheet with statuses from all Use Case
worksheets

Dim UserSheet As Worksheet
Dim sht As Worksheet
Dim TempArray()
Dim Sheetcount As Long
Dim i As Long
Dim j As Integer
Dim TheRange As Range
Dim StatusRange As Range
Dim CurrStatus As String
Dim CellsDown As Long
Dim CellsAcross As Integer
Dim SheetName As String
Dim RollupSheetName As String
RollupSheetName = ActiveSheet.Name
Application.ScreenUpdating = False

'Get the dimensions
Sheetcount = ActiveWorkbook.Worksheets.Count
'MsgBox Sheetcount

ReDim TempArray(1 To Sheetcount, 1 To 2)

'Set Worksheet Range
Set TheRange = Range(Cells(5, 1), Cells(1000, 2))
TheRange.ClearContents

Set TheRange = Range(Cells(5, 1), Cells(Sheetcount, 2))
'Set StatusRange = Range(Cells(5, 2), Cells(1000, 2))
'StatusRange.FormatConditions.Add(xlCellValue, xlEqual, "Fail")
' With .Fill
' .ColorIndex = 6
' End With
i = 0
For Each sht In ActiveWorkbook.Worksheets
sht.Activate

SheetName = sht.Name
If InStr(SheetName, "Case") 0 Then
i = i + 1
CurrStatus = Range("K3").Value

'For i = 1 To Sheetcount
For j = 1 To 2
TempArray(i, j) = SheetName
j = j + 1
TempArray(i, j) = CurrStatus
Next j
End If
Next sht
'Transfer temporary array to worksheet
TheRange.Value = TempArray
ActiveWorkbook.Sheets("4.Status Rollup").Activate
Range("A1").Select


End Sub

Referring to same cells in all worksheets
 

I'mmaking some modifications to your code so that you don't have to
activate/select each sheet. Please save a version in case something isn't
quite right. I am not clear on what you want to accomplish with this
section. It just doesn't seem right.


For j = 1 To 2
TempArray(i, j) = SheetName
j = j + 1
TempArray(i, j) = CurrStatus
Next j

so am changing it. See comments within modified code

Option Explicit

Sub StatusSummary()
' Fill a range on Status Summary Worksheet with statuses from all Use Case
' Worksheets

Dim aWB As Excel.Workbook
Dim aWS As Excel.Worksheet

Dim UserSheet As Worksheet
Dim sht As Worksheet
Dim TempArray()
Dim Sheetcount As Long
Dim i As Long
Dim j As Integer
Dim TheRange As Range
Dim StatusRange As Range
Dim CurrStatus As String
Dim CellsDown As Long
Dim CellsAcross As Integer
Dim SheetName As String
Dim RollupSheetName As String
RollupSheetName = ActiveSheet.Name
Application.ScreenUpdating = False

Set aWB = ActiveWorkbook
'Presume that aWS is also aWB.Sheets("4.Status Rollup")

Set aWS = ActiveSheet

'Get the dimensions
Sheetcount = aWB.Worksheets.Count
'MsgBox Sheetcount

ReDim TempArray(1 To Sheetcount, 1 To 2)

'Set Worksheet Range
Set TheRange = aWS.Range(aWS.Cells(5, 1), aWS.Cells(1000, 2))
TheRange.ClearContents

Set TheRange = aWS.Range(Cells(5, 1), aWS.Cells(Sheetcount, 2))
'Set StatusRange = Range(Cells(5, 2), Cells(1000, 2))
'StatusRange.FormatConditions.Add(xlCellValue, xlEqual, "Fail")
' With .Fill
' .ColorIndex = 6
' End With
i = 0
For Each sht In aWB.Worksheets
'sht.Activate

'SheetName = sht.Name
If InStr(sht.Name, "Case") 0 Then
i = i + 1
'CurrStatus = sht.Range("K3").Value
'For i = 1 To Sheetcount
'I'm not clear on this section
TempArray(i, 1) = sht.Name
TempArray(i, 2) = sht.Range("K3").Value
End If
Next sht
'Transfer temporary array to worksheet
TheRange.Value = TempArray
'I presume that this sheet is the same as aWS, so this is not necessary
'aWB.Sheets("4.Status Rollup").Activate
aWS.Range("A1").Select


End Sub





End Sub


"KIM W" wrote:

Below is code I cobbled together to loop through all worksheets and collect
the values from cell K3 into an array and write that array to a worksheet.
Issues I am asking help on:

1. I realize this will break if a column or row is added to move my cell A5
to new address. What can I do to accommodate the possibility of rows or
columns being added to alter location of value in K3? This workbook has
about 100 worksheets. Additional worksheets may be added at any time by
unsophisticated users.

2.This code is run by a command button only on worksheet named
"4.StatusRullup" but I would like the code to tolerate a re-naming of the
worksheet. Is worksheet number a permanent attribute that doesn't chnge even
when worksheets are added or re-arranged? How do I refer to a worksheet in
VBA by number rather than name?

Any other suggestions to my cobbled-together stuff here are certainly
welcome. Once I get these issues resolved I will be altering this to take
values from 6 cells on each worksheet for status rollup.
------------------------
Sub StatusSummary()
' Fill a range on Status Summary Worksheet with statuses from all Use Case
worksheets

Dim UserSheet As Worksheet
Dim sht As Worksheet
Dim TempArray()
Dim Sheetcount As Long
Dim i As Long
Dim j As Integer
Dim TheRange As Range
Dim StatusRange As Range
Dim CurrStatus As String
Dim CellsDown As Long
Dim CellsAcross As Integer
Dim SheetName As String
Dim RollupSheetName As String
RollupSheetName = ActiveSheet.Name
Application.ScreenUpdating = False

'Get the dimensions
Sheetcount = ActiveWorkbook.Worksheets.Count
'MsgBox Sheetcount

ReDim TempArray(1 To Sheetcount, 1 To 2)

'Set Worksheet Range
Set TheRange = Range(Cells(5, 1), Cells(1000, 2))
TheRange.ClearContents

Set TheRange = Range(Cells(5, 1), Cells(Sheetcount, 2))
'Set StatusRange = Range(Cells(5, 2), Cells(1000, 2))
'StatusRange.FormatConditions.Add(xlCellValue, xlEqual, "Fail")
' With .Fill
' .ColorIndex = 6
' End With
i = 0
For Each sht In ActiveWorkbook.Worksheets
sht.Activate

SheetName = sht.Name
If InStr(SheetName, "Case") 0 Then
i = i + 1
CurrStatus = Range("K3").Value

'For i = 1 To Sheetcount
For j = 1 To 2
TempArray(i, j) = SheetName
j = j + 1
TempArray(i, j) = CurrStatus
Next j
End If
Next sht
'Transfer temporary array to worksheet
TheRange.Value = TempArray
ActiveWorkbook.Sheets("4.Status Rollup").Activate
Range("A1").Select


End Sub

Referring to same cells in all worksheets
 

Thanks for the improvements to the VBA code! I implemented them without issue.
I do still seek to solve the hard coded reference to cell K3 in each of the
100 worksheets so that this still works if a user adds a column or row
affecting location of value currently stored in K3. Any suggestions?

Kim W.

"Barb Reinhardt" wrote:

I'mmaking some modifications to your code so that you don't have to
activate/select each sheet. Please save a version in case something isn't
quite right. I am not clear on what you want to accomplish with this
section. It just doesn't seem right.


For j = 1 To 2
TempArray(i, j) = SheetName
j = j + 1
TempArray(i, j) = CurrStatus
Next j

so am changing it. See comments within modified code

Option Explicit

Sub StatusSummary()
' Fill a range on Status Summary Worksheet with statuses from all Use Case
' Worksheets

Dim aWB As Excel.Workbook
Dim aWS As Excel.Worksheet

Dim UserSheet As Worksheet
Dim sht As Worksheet
Dim TempArray()
Dim Sheetcount As Long
Dim i As Long
Dim j As Integer
Dim TheRange As Range
Dim StatusRange As Range
Dim CurrStatus As String
Dim CellsDown As Long
Dim CellsAcross As Integer
Dim SheetName As String
Dim RollupSheetName As String
RollupSheetName = ActiveSheet.Name
Application.ScreenUpdating = False

Set aWB = ActiveWorkbook
'Presume that aWS is also aWB.Sheets("4.Status Rollup")

Set aWS = ActiveSheet

'Get the dimensions
Sheetcount = aWB.Worksheets.Count
'MsgBox Sheetcount

ReDim TempArray(1 To Sheetcount, 1 To 2)

'Set Worksheet Range
Set TheRange = aWS.Range(aWS.Cells(5, 1), aWS.Cells(1000, 2))
TheRange.ClearContents

Set TheRange = aWS.Range(Cells(5, 1), aWS.Cells(Sheetcount, 2))
'Set StatusRange = Range(Cells(5, 2), Cells(1000, 2))
'StatusRange.FormatConditions.Add(xlCellValue, xlEqual, "Fail")
' With .Fill
' .ColorIndex = 6
' End With
i = 0
For Each sht In aWB.Worksheets
'sht.Activate

'SheetName = sht.Name
If InStr(sht.Name, "Case") 0 Then
i = i + 1
'CurrStatus = sht.Range("K3").Value
'For i = 1 To Sheetcount
'I'm not clear on this section
TempArray(i, 1) = sht.Name
TempArray(i, 2) = sht.Range("K3").Value
End If
Next sht
'Transfer temporary array to worksheet
TheRange.Value = TempArray
'I presume that this sheet is the same as aWS, so this is not necessary
'aWB.Sheets("4.Status Rollup").Activate
aWS.Range("A1").Select


End Sub





End Sub


"KIM W" wrote:

Below is code I cobbled together to loop through all worksheets and collect
the values from cell K3 into an array and write that array to a worksheet.
Issues I am asking help on:

1. I realize this will break if a column or row is added to move my cell A5
to new address. What can I do to accommodate the possibility of rows or
columns being added to alter location of value in K3? This workbook has
about 100 worksheets. Additional worksheets may be added at any time by
unsophisticated users.

2.This code is run by a command button only on worksheet named
"4.StatusRullup" but I would like the code to tolerate a re-naming of the
worksheet. Is worksheet number a permanent attribute that doesn't chnge even
when worksheets are added or re-arranged? How do I refer to a worksheet in
VBA by number rather than name?

Any other suggestions to my cobbled-together stuff here are certainly
welcome. Once I get these issues resolved I will be altering this to take
values from 6 cells on each worksheet for status rollup.
------------------------
Sub StatusSummary()
' Fill a range on Status Summary Worksheet with statuses from all Use Case
worksheets

Dim UserSheet As Worksheet
Dim sht As Worksheet
Dim TempArray()
Dim Sheetcount As Long
Dim i As Long
Dim j As Integer
Dim TheRange As Range
Dim StatusRange As Range
Dim CurrStatus As String
Dim CellsDown As Long
Dim CellsAcross As Integer
Dim SheetName As String
Dim RollupSheetName As String
RollupSheetName = ActiveSheet.Name
Application.ScreenUpdating = False

'Get the dimensions
Sheetcount = ActiveWorkbook.Worksheets.Count
'MsgBox Sheetcount

ReDim TempArray(1 To Sheetcount, 1 To 2)

'Set Worksheet Range
Set TheRange = Range(Cells(5, 1), Cells(1000, 2))
TheRange.ClearContents

Set TheRange = Range(Cells(5, 1), Cells(Sheetcount, 2))
'Set StatusRange = Range(Cells(5, 2), Cells(1000, 2))
'StatusRange.FormatConditions.Add(xlCellValue, xlEqual, "Fail")
' With .Fill
' .ColorIndex = 6
' End With
i = 0
For Each sht In ActiveWorkbook.Worksheets
sht.Activate

SheetName = sht.Name
If InStr(SheetName, "Case") 0 Then
i = i + 1
CurrStatus = Range("K3").Value

'For i = 1 To Sheetcount
For j = 1 To 2
TempArray(i, j) = SheetName
j = j + 1
TempArray(i, j) = CurrStatus
Next j
End If
Next sht
'Transfer temporary array to worksheet
TheRange.Value = TempArray
ActiveWorkbook.Sheets("4.Status Rollup").Activate
Range("A1").Select


End Sub