Sam
Sam

Reputation: 91

Modify a userform to work on multiple sheets

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

Answers (2)

John Coleman
John Coleman

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:

enter image description here

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

ChipsLetten
ChipsLetten

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

Related Questions