K
KIM W
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
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