Using VBA code to Copy Specific value from a cell when the dropdown box changes that value - vba

I am new to VBA and have only recently been developing my excel skills.
I have created 3 different scenarios for an investment project situation, these scenarios appear in cell "h13" as a drop down box with three options being available, best case/worst case/base case.
When you select each scenario the various outputs will change on the sheet and I have set up the following code to change the outputs and display the relevant ones according to the scenario:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$13" Then
ActiveSheet.Scenarios(Target.Value).Show
End If
Now, what I want to achieve is the following:
In Cell E13 I have a numeric value that is my main concern (I should note this is an NPV Formula). Every
time we change scenario this value obviously changes.
I would like
to create a summary table that is simply something like this:
Scenario 1 = x Scenario 2 = y Scenario 3 = z So Ideally what I want
to do is, when we select scenario 1 we copy the value from E13 to say
B21. When we select the next scenario E13 will obviously change,
however I would like the copied value of B21 to remain the same, and
now the new Scenario 2 value to be displayed in B22.
I have no real idea how to go about this? I have tried adding this on the bottom but the values do not remain 'static'
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("h13")) Is Nothing Then
Range("E13").Copy
Range("B21:B23").PasteSpecial xlPasteValues
End If
End Sub
Now I think I know that I need to create a reference so that it would read something like when e13=y then copy, next e13=x copy and loop? it until all outcomes have occured. Not sure how to do it though.
Any help would be appreciated, I have tried to read up on this as much as possible but I cannot really exactly pin point what I need in code terms as I am very new to this
Thanks in advance.

This solution shows the results in a "range\table" located at B20:D23 (see pictures below)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTbl As Range, lRow As Long
Application.EnableEvents = False 'To avoid triggering again when table is updated
If Target.Address = "$H$13" Then
Rem Filters value in target range
Select Case Target.Value2
Case "Base case", "Best case", "Worst case" 'Change as required
Case Else: GoTo ExitTkn 'Value is not in the list then exit
End Select
Rem Show Scenario
ActiveSheet.Scenarios(Target.Value).Show
Rem Update Results
Set rTbl = Range("B21").Resize(3, 3) 'Change as required
With rTbl
lRow = WorksheetFunction.Match(Target.Value, .Columns(1), 0)
.Cells(lRow, 2).Value = Range("E13").Value2 'Updates result - Change as required
.Cells(lRow, 3).Value = Range("D13").Value2 'Updates scenario variable - Change as required
End With
End If
ExitTkn:
Application.EnableEvents = True
End Sub
Suggest to read the following pages to gain a deeper understanding of the resources used:
Select Case Statement,
With Statement

Related

VBA - Select Top of Matrix

I'm using a "worksheet_selectionChange" event to fire a macro whenever a cells within certain ranges are selected.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Cells.Offset(-???,0).Value
Case "LABEL_1"
Tenor = "2W"
Call MyLameMacro()
Case....
End Select
End Sub
Those ranges look like little matricies:
If the user selects any of the cells underneath label, I want VBA to lookup whatever the label is at the top. Using offset would work if I knew exactly how many rows up to Label, but its not constant....
Is there another way to go about that?
Thanks - KC
Barring further information about the layout ... you can use formatting to build your own search algorithm. This will slow down if it has to go through thousands of lines (find another way if your data set is that large).
You'll have to replace "labelColor" and "notLabel" with the background color of the label rows. This is assuming the above picture is accurate, and "Label" is highlighted. To find the value to replace them with, simply select the cell in question, then type "debug.print selection.interior.color" into the immediate window in VBA.
By placing the label value and the origin address in parentheses after your lame macro, you can preserve those values in the macro.
I did not test this. In order to do so I would have to guess at the setup of your workbook ... but an approximation of this code should work for you.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
i = 0
searchLoop:
If i > 100 Then
MsgBox ("Infinite loop. Click OK to stop")
Exit Sub
End If
If Target.Offset([-i], 0).Interior.Color = labelColor Then Call MyLameMacro(Target.Offset([-i], 0), Target.address)
If Target.Offset([-i], 0).Interior.Color = notLabel Then
If Target.Offset([-i], 0).Value = "Value" Then Call MyLameMacro(Target.Offset([-i], [-1]).Value, Target.address)
i = i + 1
GoTo searchLoop
End If
End Sub

Dynamically, continously, set a cell's value according to ActiveCell's value (which is on another worksheet)

I have a workbook with a two sheets, Rep and Aux.
I want to dynamically set Aux!A2 to the value of the ActiveCell, which is on sheet Rep, but only if the ActiveCell is on column D of that sheet (in the range Rep!D2:D5000).
To top it all of I need this mechanism to run as long as the workbook is active, not just a one-shot.
For example: While being on sheet Rep I place the cursor, i.e. ActiveCell on cell D2. I expect Aux!A2 to be set to the value of Rep!D2. I move the cursor to, say, Rep!F5 and expect nothing to happen to Aux!A2, lastly, I activate cell Rep!D7 and again, expect Aux!A2 to get the ActiveCell's value. Continue till I close the workbook.
My VBA skills are non-existent and Googling, the only thing remotely close to what I described was:
Sub Macro1()
If Not Intersect(ActiveCell, Sheets("Rep").Range("D2:D5000")) Is Nothing Then Sheets("Aux").Range("A2").Value = ActiveCell.Value
End Sub
Which fails completely.
Put this in the code of the "Rep" worksheet. Triggers anytime a cell is selected on that sheet, if the cell is in column 4 (D) then it sets the value of the cell on Aux to match.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 4 Then
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
End If
End Sub
EDIT: In response to comments.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub
This subroutine is an event that exists on every worksheet. Any time a selection changes it will run any code you put in it. The "ByVal Target as Excel.Range" part is saying it's giving you a copy of the target range being selected, because you could select more then one cell.
If Target.Column = 4 Then
end if
This is an If Block. If the condition is true, any code between the "Then" and the "End If" will execute. The condition is if the target's column is 4 in this case.
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
This sets the cell at row 2 column 1 value to match the value of the target that was selected.
Now that I think about it I wonder what this code will do if you select a range of cells.....

VBA go to next row and pull formula from above after data has been entered

I have the excel formula below to pull data from another sheet.
=IF(ISNUMBER(SEARCH("Yes",Sheet7!C4)),Sheet7!A4,"")
These cells used, C4 and A4, will always remain the same. Different item numbers are being scanned in one after another so the values in the cells will change.
When the word Yes is shown in C4 i would like it to record the item # in A4 into the new sheet. This formula works great for that.
However, after the item # is recorded in the new sheet, i would like it to go down to the next row and copy the formula so it can record the next item # scanned.
Is this VBA possible? thank you!
I think you are trying to get something like
If Worksheets("Sheet7").Range("C4").Value Like "*Yes*" Then
ActiveCell.Value = Worksheets("Sheet7").Range("A4").Value
Else
ActiveCell.Value = ""
End If
but don't use ActiveCell - use a proper reference to the cell in which you want to put the value. (Your question doesn't contain enough information to determine what the location is, which is why I was forced to just refer to it as ActiveCell.)
Based on comments, it sounds like you want the following Worksheet_Change event in Worksheets("Sheet7"):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count <> 1 Then
Exit Sub
End If
If Intersect(Range("A4"), Target) Is Nothing Then
Exit Sub
End If
If Range("C4").Value Like "*Yes*" Then
With Worksheets("Sheet1")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = Target.Value
End With
End If
End Sub

Filtering data in another worksheet using multiple non-contiguous cell values

I've looked around for the past few days to find an answer to this, but haven't found anything that refers to all aspects of my query. I'm hoping that somebody here can help me/point me in the right direction!
Essentially, I have a Store List and a Customer list (with the store each customer has visited) in two different sheets within one workbook, comprising a one to many relationship. I want to be able to filter the Customer List dynamically by selecting stores in the Store List, although have only managed to filter by one value (Store) so far, using the below code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then
Sheet2.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=ActiveCell.Value
Sheet2.Activate
End If
End Sub
Though this is, of course, only a solution for when one store needs to be selected. Should I need to make a non-contiguous selection of cells, how would I go around this?
Any help would be greatly appreciated!
My way to do it would be to handle multiple selections. The code looks like shown bellow (TblCustomer is your "Table1"):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rgSel As Range, rgCell As Range
Dim cellsFound As Integer
Dim filters() As String
Set rgSel = Selection
cellsFound = 0
For Each rgCell In rgSel
If rgCell.Column = 1 Then
cellsFound = cellsFound + 1
ReDim Preserve filters(cellsFound)
filters(cellsFound - 1) = rgCell
End If
Next rgCell
If cellsFound > 0 Then
Sheet2.ListObjects("TblCustomers").Range.AutoFilter Field:=1, Criteria1:=filters, Operator:=xlFilterValues
'you may need to select the customer sheet manually after you made your multiple selection,
'otherwise you'll just jump to it avery time you change the selection
'Sheet2.Activate
End If
End Sub

Excel - Lock Range of Cells Based on Values

Is it possible to lock a particular range of cells based on the input from a dropdown in a row of data?
For example, each row of my spreadsheet represents a patient, and the first cell asks a question, to which a "Yes" or "No" response is required (which is selected/entered via a dropdown).
EDIT
The "Yes/No" cell is, in fact, a merge of two cells (G13 & H13). I have updated my example to reflect this.
EDIT ENDS
If the user selects "No", then I wish to lock the remainder of the range of questions (G13-H13:AB13) as there is no need to enter data here. However, if the user selects, "Yes", then the remainder of the cells shall remain available to enter data into.
All cells within each range have data entered via dropdowns only.
Here is what I am hoping to achieve:
If "No"
Then lock range G13-H13:AB13
Else If "Yes"
Then do nothing
i.e.
G13-H13 I13-J13 K13-L13 .... .... AB13
| NO | ---- | ---- | ---- | ---- | ---- | (Locked Cells)
OR
G13-H13 I13-J13 K13-L13 .... .... AB13
| YES | | | | | | (Unlocked Cells)
Once again, I would like to emphasize that all data is entered via dropdown menus and that nothing is to be typed in manually; I would like it so that if G13-H13 = "No", then the remainder of the cells within the range which have dropdowns are blocked or locked from having further information selected from their respective dropdowns.
Please note that the value in G13-H13 can be either "Yes" or "No".
Can this be achieved using VBA and if so, how?
Many thanks.
EDIT:
You can do this without VBA. I based this on another answer here: https://stackoverflow.com/a/11954076/138938
Column G has the Yes or No drop-down.
In cell H13, set up data validation like this:
Data --> Data Validation
Select List in the Allow drop-down.
Enter this formula in the Source field: =IF($G13="Yes", MyList, FALSE)
Copy cell H13 and paste the validation (paste --> pastespecial --> validation) to cells I13:AB13.
Replace MyList in the formula with the list you want to allow the user to select from for each column. Note that you'll need to have the patient answer set to "Yes" in order to set up the validation. Once you set it up, you can delete it or set it to No.
Once you have the validation set up for row 13, copy and paste the validation to all rows that need it.
If you want to use VBA, use the following, and use the worksheet_change event or some other mechanism to trigger the LockOrUnlockPatientCells. I don't like using worksheet_change, but it may make sense in this case.
In order for the cells to be locked, you need to lock them and then protect the sheet. The code below does that. You need to pass it the row for the patient that is being worked on.
Sub LockOrUnlockPatientCells(PatientRow As Long)
Dim ws As Worksheet
Dim YesOrNo As String
Set ws = ActiveSheet
YesOrNo = ws.Range("g" & PatientRow).Value
' unprotect the sheet so that we can modify locked settings
ws.Unprotect
ws.Range("a:g").Cells.Locked = False
' lock row
Range("h" & PatientRow & ":AB" & PatientRow).Cells.Locked = True
' unlock the row depending on answer
If YesOrNo = "Yes" Then
Range("h" & PatientRow & ":AB" & PatientRow).Cells.Locked = False
End If
' protect the sheet again to activate the locked cells
ws.Protect
End Sub
You can test the functionality by using the following, manually adjusting the values for the patient row. Once you get it to work the way you want, get the row from the user's input.
Sub testLockedCells()
Dim AnswerRow As Long
AnswerRow = 9
LockOrUnlockPatientCells AnswerRow
End Sub
This code should get you started. You may need to tweak it to suit your specific needs, but I based my logic on the details in your original post.
Place the module in the respective Worksheet Object in the VBE.
Private Sub Worksheet_Change(ByVal Target As Range)
'assumes cell changed in column G and first row of data entry is 13
If Target.Column = 7 And Target.Row > 12 Then 'change to If Intersect(Target, Range("G13")) Then if all you care about is G13
Application.EnableEvents = False 'stop events from processing
Dim blnLock As Boolean
Dim r As Integer
Select Case Target.Value
Case Is = "No"
blnLock = True
r = 191
Case Is = "Yes"
blnLock = False
r = 255
End Select
Unprotect Password:="myPassword"
With Range("H" & Target.Row & ":AB" & Target.Row)
'just a suggestion, fill the cells grey before locking them, or turn them back to no fill if it's unlocked
.Interior.Color = RGB(r, r, r)
.Locked = blnLock
End With
.Protect Password:="myPassword"
Application.EnableEvents = True
End If
End Sub
Try this : -
Apply a Loop and then check
if "NO"
ws.get_Range(StartCell, EndCell).Locked = true;
// where ws is the worksheet object The only point to be seen is that if the Sheet is Locked you need to unlock it and then proceed
else if "YES"
continue;