Reputation: 91
I have spent much of the last few weeks struggling through making a few userforms (not one of my strengths). With my intended userform the user can select whatever values they want to on a spreadsheet (for example asset prices) and then apply the spinner, this mimics an increase/decrease of a % in the price of those assets etc and then they can observe how this impacts various aspects of the business. Then they have two buttons, one that can keep the adjusted values and another to reset the values.
So far I have one userform that appears to work over various sheets but the selected ranges have to be contiguous and one, with great help on here (see a previous question from myself), that works perfectly for noncontiguous selections however they have to be on the same worksheet. However I would ideally like to be able to select a number of non-contiguous ranges over a number of worksheets and be able to edit these. I am reliably informed that range variables can only refer to ranges on a specific sheet which I suppose is where I am going wrong.
The code for that works for non-contiguous ranges is below, I honestly can't take much credit for getting this far though as I have needed a lot of help from here and I haven't tidied it up completely yet, can anyone suggest how I could edit or revamp this to work across numerous worksheets and non-contiguous ranges at the same time?
Opening Userform;
Public myRange As Range, myArea As Range
Public myCopy As Variant
Public i As Long, numAreas As Long
Public pvar As Double
Sub Button2_Click()
Spinner.Show
End Sub
The userform:
Option Explicit
'on opening userform this sets the variables
Private Sub UserForm_Activate()
pvar = 1
Set myRange = Selection
numAreas = myRange.Areas.Count
If numAreas = 1 Then
myCopy = myRange.Value
Else
ReDim myCopy(1 To numAreas)
For i = 1 To numAreas
myCopy(i) = myRange.Areas(i).Value
Next i
End If
End Sub
'Useful Subs
Sub RestoreVals(R As Range, V As Variant)
Dim A As Range
Dim i As Long, n As Long
n = R.Areas.Count
If n = 1 Then
R.Value = V
Else
For i = 1 To n
R.Areas(i).Value = V(i)
Next i
End If
End Sub
Sub Multiply(R As Range, p As Double)
Dim c As Range
For Each c In R.Cells
c.Value = p * c.Value
Next c
End Sub
'Spin Up button
Private Sub SpinButton1_SpinUp()
Dim myRange As Range, myCopy As Variant
Set myRange = Selection
'Reset Values so that pvar is * by the right values
CopyVals myRange, myCopy
Multiply myRange, (1 / pvar)
'Now * by pvar
CopyVals myRange, myCopy
pvar = pvar + UpBox.Value / 100
Multiply myRange, pvar
End Sub
' Spin Down button
Private Sub SpinButton1_SpinDown()
Dim myRange As Range, myCopy As Variant
Set myRange = Selection
'Reset Values so that pvar is * by the right values
CopyVals myRange, myCopy
Multiply myRange, (1 / pvar)
'Now * by pvar
CopyVals myRange, myCopy
pvar = pvar - DownBox.Value / 100
Multiply myRange, pvar
End Sub
'Button to return to starting values
Public Sub DefaultButton_Click()
If numAreas = 1 Then
myRange.Value = myCopy
Else
For i = 1 To numAreas
myRange.Areas(i).Value = myCopy(i)
Next i
End If
End Sub
'button to maintain adjusted values
Private Sub CommandButton1_Click()
UserForm3.Show
End Sub
Upvotes: 2
Views: 1462
Reputation: 51998
As proof of concept I created the following userform. In the editor I set ShowModal equal to False. This is important since it allows the user to switch to different sheets while the form is showing. It looks like this:
The following code shows one way of allowing a user to select possibly noncontiguous ranges on separate sheets, modify them by a multiplicative factor, and then restore the original values:
Option Explicit
Dim valCopies As Collection
Dim ranges As Collection
Private Sub UserForm_Initialize()
Dim r As Range
tbChangeFactor.Value = "1.0"
Set ranges = New Collection
Set valCopies = New Collection
For Each r In Selection.Areas
ranges.Add r
valCopies.Add r.Value
Next r
End Sub
Private Sub btnChange_Click()
Dim r As Range, c As Range, p As Double
Application.ScreenUpdating = False
p = tbChangeFactor.Value
For Each r In ranges
For Each c In r.Cells
c = c * p
Next c
Next r
Application.ScreenUpdating = True
End Sub
Private Sub btnRestore_Click()
Dim i As Long, n As Long
n = ranges.Count
For i = 1 To n
ranges(i).Value = valCopies(i)
Next i
End Sub
Private Sub btnSelect_Click()
Dim choice As Range, A As Range
Dim home As Worksheet, ws As Worksheet
Set valCopies = New Collection
Set ranges = New Collection
Set home = ActiveSheet
For Each ws In Sheets
ws.Select
Set choice = Nothing
On Error Resume Next 'when the user hits cancel
Set choice = Application.InputBox("Select cells from " & ws.Name, "Change/Restore", Selection.Address, , , , , 8)
On Error GoTo 0
If Not choice Is Nothing Then
choice.Select 'for future reference
For Each A In choice.Areas
ranges.Add A
valCopies.Add A.Value
Next A
End If
Next ws
home.Select
End Sub
It would be easy to modify so that the select ranges sub only iterates over a predetermined collection of sheets. If I understand what you are trying to do, you might want to run the restore sub at the beginning of the select range sub if you want to make sure that the original (as opposed to modified) values are saved when the user runs the select sub more than once. The code hasn't been thoroughly tested but seems to work. A word of warning -- areas can overlap if the user does weird things while selecting. The above code would modify any cells contained in any such overlaps 2 (or more) times. To be really safe you might want to modify the selecting code to make sure that the areas don't overlap. One way would be to run the areas through Chip Pearson's excellent ProperUnion function: http://www.cpearson.com/Excel/BetterUnion.aspx
Upvotes: 2
Reputation: 2953
Each Excel Window
keeps track of the cells selected, so you could loop through the Windows
collection:
Dim wdw As Window
For Each wdw In Application.Windows
Debug.Print wdw.Selection.Address(External:=True)
Next wdw
But the problem with this approach is that your code needs to make sure the user only has open the expected workbooks or tests every workbook. Also, what happens if the user has a workbook in several views (the New Window button on the View tab)?
Upvotes: 0