J
John T Ingato
I have a column of numbers that are updated in a form each time a change is
made. Each time I enter a number and click add, the number is added to a
sheet and then I call a function UpdateForms to Update the listboxes in my
forms. The UpdateForms is called at the beginning of the program run also
to set the listboxes to their proper state and it all works fine.
It appears that when I switch from from one tab of a multipage to another,
then back again, and then I delete one of the entries in the listbox, the
following below code fails. I can delete entry successfully if I do not
swicth tabs. Furthermore , switching tabs alone doesnt always cause the
failure. I must switch tabs, then click on one of the controls to set the
focus to that control, which happens to be another listbox.
ThisWorkbook.Sheets("Names").Activate
Set rNameRange = Cells(1, 1).CurrentRegion.Columns(1) *******FAILS
error '1004' Unable to get the current region of the range class
Below is the full code of my setup form if you are interested
***************************************************************
Option Explicit
Private Sub MultiPage1_Change()
Select Case SetUpPage.MultiPage1.Value
Case Is = 0
SetUpPage.NameEntry.SetFocus
SetUpPage.AddRepButton.Default = True
Case Is = 1
SetUpPage.StoreEntry.SetFocus
SetUpPage.bAddStore.Default = True
Case Is = 2
End Select
End Sub
Private Sub SaveButton_Click()
Call MakeBackup
Unload Me
Menu.Show
End Sub
Private Sub ApplyButton1_Click()
Call MakeBackup
End Sub
Private Sub CancelButton_Click()
Call GetBackup
Unload Me
Menu.Show
End Sub
Private Sub AddRepButton_Click()
ThisWorkbook.Sheets("Names").Activate
Dim IsDup As Boolean
Dim rNextEmpty As range
Dim rNameRange As range
Set rNextEmpty = Utilities.FindEndOfDataIn("col", range("A1"),
"nextemptycell")
Set rNameRange = Utilities.FindEndOfDataIn("col", range("A1"), "range")
If NameEntry = "" Then
Call Sound("Empty")
Exit Sub
End If
Call Sound("Add") 'Nifty popping Sound
'********** Add Entry to sheet and ListBox then Clear Text Box **********
IsDup = Utilities.IsDup(NameEntry, rNameRange)
If IsDup = True Then Exit Sub
rNextEmpty = NameEntry
NameEntry = ""
Set rNameRange = Sheets("Names").Cells(1, 1).CurrentRegion.Columns(1)
RepEntryBox.RowSource = rNameRange.Address
ListOfRepsBox.RowSource = rNameRange.Address
SetUpPage.NameEntry.SetFocus
'Reactivate the blank background
Worksheets("Start").Activate
End Sub
Private Sub RemoveButton_Click()
ThisWorkbook.Sheets("Names").Activate
Dim CurrentRow As Integer ' Work Sheet Index
Dim NameCount As Integer
'**********Check to make sure there is at least 1 cell with data in the
workbook *****
'**********And set the var "Nameset" to the number of cell in the list
'***************************************************************************
**********
CurrentRow = RepEntryBox.ListIndex + 1 '*** correlate the cell row with
the list number
If CurrentRow = 0 Then ' Nothing selected returns a list
index of (-1)
Sound ("Empty")
Exit Sub
End If
Sound ("Remove")
Rows(CurrentRow).Delete Shift:=xlUp
Call UpdateForm
End Sub
Private Sub ListOfRepsBox_Click()
UpdateForm
If Me.MultiPage1.Value = 1 Then Me.StoreEntry.SetFocus
End Sub
Private Sub RepEntryBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call RemoveButton_Click
End Sub
Private Sub Sort_Click()
Call SortIt
End Sub
Private Sub bAddStore_click()
ThisWorkbook.Sheets("Stores").Activate
Dim rStoreRange As range
Dim rCurrentRecord As range
Dim NextEmptyStore As range
If ListOfRepsBox.ListIndex < 0 Then
MsgBox "You Must Select A Rep First"
Exit Sub
End If
Set rCurrentRecord = Cells(1, ListOfRepsBox.ListIndex + 1)
Set rStoreRange = FindEndOfDataIn("Col", rCurrentRecord, "range")
Set NextEmptyStore = Utilities.FindEndOfDataIn("col", rStoreRange,
"nextemptycell")
If StoreEntry = "" Then
Call Sound("Empty")
Exit Sub
End If
Call Sound("Add")
If Utilities.IsDup(StoreEntry, rStoreRange) = True Then Exit Sub
NextEmptyStore = StoreEntry
Me.StoreEntry = ""
Me.StoreEntry.SetFocus
Call UpdateForm
End Sub
Private Sub UpdateForm()
Dim rNameRange As range
Dim CurrentRecord As Integer
ThisWorkbook.Sheets("Names").Activate
Set rNameRange = Cells(1, 1).CurrentRegion.Columns(1)
RepEntryBox.RowSource = rNameRange.Address
ListOfRepsBox.RowSource = rNameRange.Address
ThisWorkbook.Sheets("Stores").Activate
If Me.ListOfRepsBox.ListIndex < 0 Then
Me.RepStoreList.Clear
Exit Sub
End If
CurrentRecord = Me.ListOfRepsBox.ListIndex + 1
Set rNameRange = Sheets("Stores").Cells(1,
CurrentRecord).CurrentRegion.Columns(CurrentRecord)
Me.RepStoreList.RowSource = rNameRange.Address
End Sub
Private Sub MakeBackup(Optional SheetName As String)
Dim ConsecutiveRegion As range
Worksheets("tNames").Cells.Clear
If SheetName = "" Then SheetName = "all"
SheetName = LCase(SheetName)
Select Case SheetName
Case Is = "names"
Set ConsecutiveRegion =
Worksheets("Names").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tNames").range("A1"))
Case Is = "stores"
Set ConsecutiveRegion =
Worksheets("Stores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tStores").range("A1"))
Case Is = "all"
Set ConsecutiveRegion =
Worksheets("Names").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tNames").range("A1"))
Set ConsecutiveRegion =
Worksheets("Stores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tStores").range("A1"))
End Select
End Sub
Private Sub GetBackup(Optional SheetName As String)
Dim ConsecutiveRegion As range
Worksheets("Names").Cells.Clear
If SheetName = "" Then SheetName = "all"
SheetName = LCase(SheetName)
Select Case SheetName
Case Is = "names"
Set ConsecutiveRegion =
Worksheets("tNames").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("names").range("A1"))
Case Is = "stores"
Set ConsecutiveRegion =
Worksheets("tStores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("Stores").range("A1"))
Case Is = "all"
Set ConsecutiveRegion =
Worksheets("tNames").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("Names").range("A1"))
Set ConsecutiveRegion =
Worksheets("tStores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("Stores").range("A1"))
End Select
End Sub
Private Sub UserForm_Activate()
Application.Windows(ThisWorkbook.Name).Activate
Call MultiPage1_Change
Call SortIt
Call MakeBackup
Call UpdateForm
Me.MultiPage1.Value = 0
End Sub
made. Each time I enter a number and click add, the number is added to a
sheet and then I call a function UpdateForms to Update the listboxes in my
forms. The UpdateForms is called at the beginning of the program run also
to set the listboxes to their proper state and it all works fine.
It appears that when I switch from from one tab of a multipage to another,
then back again, and then I delete one of the entries in the listbox, the
following below code fails. I can delete entry successfully if I do not
swicth tabs. Furthermore , switching tabs alone doesnt always cause the
failure. I must switch tabs, then click on one of the controls to set the
focus to that control, which happens to be another listbox.
ThisWorkbook.Sheets("Names").Activate
Set rNameRange = Cells(1, 1).CurrentRegion.Columns(1) *******FAILS
error '1004' Unable to get the current region of the range class
Below is the full code of my setup form if you are interested
***************************************************************
Option Explicit
Private Sub MultiPage1_Change()
Select Case SetUpPage.MultiPage1.Value
Case Is = 0
SetUpPage.NameEntry.SetFocus
SetUpPage.AddRepButton.Default = True
Case Is = 1
SetUpPage.StoreEntry.SetFocus
SetUpPage.bAddStore.Default = True
Case Is = 2
End Select
End Sub
Private Sub SaveButton_Click()
Call MakeBackup
Unload Me
Menu.Show
End Sub
Private Sub ApplyButton1_Click()
Call MakeBackup
End Sub
Private Sub CancelButton_Click()
Call GetBackup
Unload Me
Menu.Show
End Sub
Private Sub AddRepButton_Click()
ThisWorkbook.Sheets("Names").Activate
Dim IsDup As Boolean
Dim rNextEmpty As range
Dim rNameRange As range
Set rNextEmpty = Utilities.FindEndOfDataIn("col", range("A1"),
"nextemptycell")
Set rNameRange = Utilities.FindEndOfDataIn("col", range("A1"), "range")
If NameEntry = "" Then
Call Sound("Empty")
Exit Sub
End If
Call Sound("Add") 'Nifty popping Sound
'********** Add Entry to sheet and ListBox then Clear Text Box **********
IsDup = Utilities.IsDup(NameEntry, rNameRange)
If IsDup = True Then Exit Sub
rNextEmpty = NameEntry
NameEntry = ""
Set rNameRange = Sheets("Names").Cells(1, 1).CurrentRegion.Columns(1)
RepEntryBox.RowSource = rNameRange.Address
ListOfRepsBox.RowSource = rNameRange.Address
SetUpPage.NameEntry.SetFocus
'Reactivate the blank background
Worksheets("Start").Activate
End Sub
Private Sub RemoveButton_Click()
ThisWorkbook.Sheets("Names").Activate
Dim CurrentRow As Integer ' Work Sheet Index
Dim NameCount As Integer
'**********Check to make sure there is at least 1 cell with data in the
workbook *****
'**********And set the var "Nameset" to the number of cell in the list
'***************************************************************************
**********
CurrentRow = RepEntryBox.ListIndex + 1 '*** correlate the cell row with
the list number
If CurrentRow = 0 Then ' Nothing selected returns a list
index of (-1)
Sound ("Empty")
Exit Sub
End If
Sound ("Remove")
Rows(CurrentRow).Delete Shift:=xlUp
Call UpdateForm
End Sub
Private Sub ListOfRepsBox_Click()
UpdateForm
If Me.MultiPage1.Value = 1 Then Me.StoreEntry.SetFocus
End Sub
Private Sub RepEntryBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call RemoveButton_Click
End Sub
Private Sub Sort_Click()
Call SortIt
End Sub
Private Sub bAddStore_click()
ThisWorkbook.Sheets("Stores").Activate
Dim rStoreRange As range
Dim rCurrentRecord As range
Dim NextEmptyStore As range
If ListOfRepsBox.ListIndex < 0 Then
MsgBox "You Must Select A Rep First"
Exit Sub
End If
Set rCurrentRecord = Cells(1, ListOfRepsBox.ListIndex + 1)
Set rStoreRange = FindEndOfDataIn("Col", rCurrentRecord, "range")
Set NextEmptyStore = Utilities.FindEndOfDataIn("col", rStoreRange,
"nextemptycell")
If StoreEntry = "" Then
Call Sound("Empty")
Exit Sub
End If
Call Sound("Add")
If Utilities.IsDup(StoreEntry, rStoreRange) = True Then Exit Sub
NextEmptyStore = StoreEntry
Me.StoreEntry = ""
Me.StoreEntry.SetFocus
Call UpdateForm
End Sub
Private Sub UpdateForm()
Dim rNameRange As range
Dim CurrentRecord As Integer
ThisWorkbook.Sheets("Names").Activate
Set rNameRange = Cells(1, 1).CurrentRegion.Columns(1)
RepEntryBox.RowSource = rNameRange.Address
ListOfRepsBox.RowSource = rNameRange.Address
ThisWorkbook.Sheets("Stores").Activate
If Me.ListOfRepsBox.ListIndex < 0 Then
Me.RepStoreList.Clear
Exit Sub
End If
CurrentRecord = Me.ListOfRepsBox.ListIndex + 1
Set rNameRange = Sheets("Stores").Cells(1,
CurrentRecord).CurrentRegion.Columns(CurrentRecord)
Me.RepStoreList.RowSource = rNameRange.Address
End Sub
Private Sub MakeBackup(Optional SheetName As String)
Dim ConsecutiveRegion As range
Worksheets("tNames").Cells.Clear
If SheetName = "" Then SheetName = "all"
SheetName = LCase(SheetName)
Select Case SheetName
Case Is = "names"
Set ConsecutiveRegion =
Worksheets("Names").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tNames").range("A1"))
Case Is = "stores"
Set ConsecutiveRegion =
Worksheets("Stores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tStores").range("A1"))
Case Is = "all"
Set ConsecutiveRegion =
Worksheets("Names").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tNames").range("A1"))
Set ConsecutiveRegion =
Worksheets("Stores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("tStores").range("A1"))
End Select
End Sub
Private Sub GetBackup(Optional SheetName As String)
Dim ConsecutiveRegion As range
Worksheets("Names").Cells.Clear
If SheetName = "" Then SheetName = "all"
SheetName = LCase(SheetName)
Select Case SheetName
Case Is = "names"
Set ConsecutiveRegion =
Worksheets("tNames").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("names").range("A1"))
Case Is = "stores"
Set ConsecutiveRegion =
Worksheets("tStores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("Stores").range("A1"))
Case Is = "all"
Set ConsecutiveRegion =
Worksheets("tNames").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("Names").range("A1"))
Set ConsecutiveRegion =
Worksheets("tStores").range("A1").CurrentRegion
ConsecutiveRegion.Copy (Worksheets("Stores").range("A1"))
End Select
End Sub
Private Sub UserForm_Activate()
Application.Windows(ThisWorkbook.Name).Activate
Call MultiPage1_Change
Call SortIt
Call MakeBackup
Call UpdateForm
Me.MultiPage1.Value = 0
End Sub