Current region problems

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
 
T

Tom Ogilvy

Try

ThisWorkbook.Sheets("Names").Activate
Set rNameRange = ThisWorkbook.Sheets("Names"). _
Cells(1, 1).CurrentRegion.Columns(1)

It that doesn't work try

ThisWorkbook.Sheets("Names").Activate
Set rNameRange = ThisWorkbook.Sheets("Names"). _
Range("A1").CurrentRegion.Columns(1)

and then

ThisWorkbook.Sheets("Names").Activate
activeCell.Activate
Set rNameRange = ThisWorkbook.Sheets("Names"). _
Range("A1").CurrentRegion.Columns(1)

--
Regards,
Tom Ogilvy
 
J

John T Ingato

I had already tried those the first two options prior to this. I did try
the last option, but that did not help. Any other suggestions?
 
T

Tom Ogilvy

Nope
Regards,
Tom Ogilvy


John T Ingato said:
I had already tried those the first two options prior to this. I did try
the last option, but that did not help. Any other suggestions?


in
'***************************************************************************
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top