Glitch5618
Board Regular
- Joined
- Nov 6, 2015
- Messages
- 105
Using excel 2007
I'm having an issue with the following code. This code works fine in other subs but for this case there appears to be some problem I'm missing. I'm sure its something simple. Maybe with my declaring variables, not really sure but I'm hoping someone could point me in the right direction.
Basically the debugger is highligting the arrays in yellow, I have all the arrays declared as public at the top of the module as 'public somearray() as variant'
Here is the code in question, I've highlighted what the debugger is showing me in yellow
I'm having an issue with the following code. This code works fine in other subs but for this case there appears to be some problem I'm missing. I'm sure its something simple. Maybe with my declaring variables, not really sure but I'm hoping someone could point me in the right direction.
Basically the debugger is highligting the arrays in yellow, I have all the arrays declared as public at the top of the module as 'public somearray() as variant'
Here is the code in question, I've highlighted what the debugger is showing me in yellow
Rich (BB code):
Sub GetLOBescalation()
Application.ScreenUpdating = False
Set d = DataBox
Set f = UserForm
Dim fnd As String, FirstFound
Dim FoundCell As Range, Rng, tRng
Dim myRange As Range, LastCell
Dim WS As Worksheet
Dim flg As Boolean
Dim LR As Long
Dim Destination As Range
For Each WS In Worksheets
If WS.Name Like "DataTemp" Then flg = True: Exit For
Next
If flg = True Then
WS.Visible = xlSheetVisible
Set Destination = Sheets("DataTemp").Range("A2")
Sheets("DataTemp").UsedRange.ClearContents
Else
Set WS = Sheets.Add: WS.Name = "DataTemp"
Set Destination = Sheets("DataTemp").Range("A2")
End If
Worksheets("Escalation Data").Activate
'Only Nesting/Production selected
If f.optEscalation.Value = True And f.cboFilter.Value = "LOB" And f.cboOption.Value = vbNullString And f.cboOption2 <> vbNullString Then
With ActiveWorkbook.Worksheets("Escalation Data")
.Range("T1:T" & .Range("T" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("T1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
GoTo NestProd
'Only LOB selected
ElseIf f.optEscalation.Value = True And f.cboFilter.Value = "LOB" And f.cboOption <> vbNullString And f.cboOption2 = vbNullString Then
With ActiveWorkbook.Worksheets("Escalation Data")
.Range("C1:C" & .Range("C" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("C1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
GoTo LOB
'Both LOB & Nesting/Production: Search for LOB first, then filter for Nesting/Production second
ElseIf f.optEscalation.Value = True And f.cboFilter.Value = "LOB" And f.cboOption <> vbNullString And f.cboOption2 <> vbNullString Then
With ActiveWorkbook.Worksheets("Escalation Data")
.Range("C1:C" & .Range("C" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("C1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
GoTo LOB_NestProd
End If
'<(**<) <(**)> (>**)>
'Nesting/Production only Search
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
NestProd:
Worksheets("Escalation Data").Activate
fnd = f.cboOption2.Value
Set myRange = ActiveSheet.Range("T:T")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
'Search loop
Set Rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set Rng = Union(Rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Resize rng to include respective data and assign rng to array
Set Rng = Rng.Offset(, -19).Resize(, 21)
NestingProductionArray = Rng
Destination.Resize(UBound(NestingProductionArray, 1), UBound(NestingProductionArray, 2)).Value = NestingProductionArray
Erase NestingProductionArray
'Set table range
LR = WS.Cells(Rows.Count, "A").End(xlUp).Row
Set tRng = WS.Range("A1:U" & LR)
'Copy the table headers from question data
Worksheets("Escalation Data").Range("A1:U1").Copy
Worksheets("DataTemp").Range("A1").PasteSpecial xlPasteValues
'Create table to allow columns to be sorted
Worksheets("DataTemp").Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:U" & LR), , xlYes).Name = "TempTable"
'Sort agent names
With ActiveWorkbook.Worksheets("DataTemp")
.Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
'Offset of usedrange prevents table headers from displaying in listbox
NestingProductionArray = WS.Range("A2:U" & LR)
d.listEscalation.List = NestingProductionArray
d.listEscalation.ColumnCount = 21
d.listEscalation.ColumnWidths = ";;;;;;;;;;;;;;;;;;;;"
d.MultiPage1.Value = 1
If DataBox.Visible = True Then frmloaded = True
If DataBox.Visible = False Then frmloaded = False
If frmloaded = True Then
ElseIf frmloaded = False Then
DataBox.Show
End If
WS.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Exit Sub
'LOB only Search
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LOB:
fnd = f.cboOption.Value
Set myRange = ActiveSheet.Range("C:C")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
'Search loop
Set Rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set Rng = Union(Rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Resize rng to include respective data and assign rng to array
Set Rng = Rng.Offset(, -2).Resize(, 21)
LOBescalationArray = Rng
Destination.Resize(UBound(LOBescalationArray, 1), UBound(LOBescalationArray, 2)).Value = LOBescalationArray
Erase LOBescalationArray
'Set table range
LR = WS.Cells(Rows.Count, "A").End(xlUp).Row
Set tRng = WS.Range("A1:U" & LR)
'Copy the table headers from question data
Worksheets("Escalation Data").Range("A1:U1").Copy
Worksheets("DataTemp").Range("A1").PasteSpecial xlPasteValues
'Create table to allow columns to be sorted
Worksheets("DataTemp").Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:U" & LR), , xlYes).Name = "TempTable"
'Sort agent names
With ActiveWorkbook.Worksheets("DataTemp")
.Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
'Offset of usedrange prevents table headers from displaying in listbox
LOBescalationArray = WS.Range("A2:U" & LR)
d.listEscalation.List = LOBescalationArray
d.listEscalation.ColumnCount = 21
d.listEscalation.ColumnWidths = ";;;;;;;;;;;;;;;;;;;;"
d.MultiPage1.Value = 1
If DataBox.Visible = True Then frmloaded = True
If DataBox.Visible = False Then frmloaded = False
If frmloaded = True Then
ElseIf frmloaded = False Then
DataBox.Show
End If
WS.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Exit Sub
'LOB & Nesting/Production Search
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LOB_NestProd:
fnd = f.cboOption.Value
Set myRange = ActiveSheet.Range("C:C")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
GoTo LOB_NestProdSearch
LOB_NestProdSearch:
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
'Search loop
Set Rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set Rng = Union(Rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Resize rng to include respective data and assign rng to array
Set Rng = Rng.Offset(, -2).Resize(, 21)
LOBnestingProductionArray = Rng
Destination.Resize(UBound(LOBnestingProductionArray, 1), UBound(LOBnestingProductionArray, 2)).Value = LOBnestingProductionArray
Erase LOBnestingProductionArray
'Set table range
LR = WS.Cells(Rows.Count, "A").End(xlUp).Row
Set tRng = WS.Range("A1:U" & LR)
'Copy the table headers from question data
Worksheets("Escalation Data").Range("A1:U1").Copy
Worksheets("DataTemp").Range("A1").PasteSpecial xlPasteValues
'Create table to allow columns to be sorted
Worksheets("DataTemp").Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:U" & LR), , xlYes).Name = "TempTable"
'Sort Nesting/Production column
With ActiveWorkbook.Worksheets("DataTemp")
.Range("T1:T" & .Range("T" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("T1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
'Second search: Nesting/Production
Worksheets("DataTemp").Activate
fnd = f.cboOption2.Value
Set myRange = ActiveSheet.Range("T:T")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
'Search loop
Set Rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set Rng = Union(Rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Resize rng to include respective data and assign rng to array
Set Rng = Rng.Offset(, -19).Resize(, 21)
LOBnestingProductionArray = Rng
'Clear DataTemp sheet of previous content, loads only wanted data
Sheets("DataTemp").UsedRange.ClearContents
Destination.Resize(UBound(LOBnestingProductionArray, 1), UBound(LOBnestingProductionArray, 2)).Value = LOBnestingProductionArray
Erase LOBnestingProductionArray
'Set table range
LR = WS.Cells(Rows.Count, "A").End(xlUp).Row
Set tRng = WS.Range("A1:U" & LR)
'Copy the table headers from question data
Worksheets("Escalation Data").Range("A1:U1").Copy
Worksheets("DataTemp").Range("A1").PasteSpecial xlPasteValues
'Create table to allow columns to be sorted
Worksheets("DataTemp").Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:U" & LR), , xlYes).Name = "TempTable"
'Sort agent names
With ActiveWorkbook.Worksheets("DataTemp")
.Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
'Load data from row 2 down to prevent table cells from showing in listbox
LOBnestingProductionArray = WS.Range("A2:U" & LR)
d.listEscalation.List = LOBnestingProductionArray
d.listEscalation.ColumnCount = 21
d.listEscalation.ColumnWidths = ";;;;;;;;;;;;;;;;;;;;"
d.MultiPage1.Value = 1
If DataBox.Visible = True Then frmloaded = True
If DataBox.Visible = False Then frmloaded = False
If frmloaded = True Then
ElseIf frmloaded = False Then
DataBox.Show
End If
WS.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Exit Sub
'Error Handler
NothingFound:
MsgBox "No escalation data found."
End Sub