I have a macro that enables the user to double-click a given cell range on a Summary worksheet and access a hidden Data worksheet containing related data. When the user returns to the Summary worksheet, the Data worksheet is re-hidden.
The macro works perfectly for range D10:G15, but doesn't work for cell range C21:G26.
Summary worksheet:
VBA:
Private Sub Worksheet_Activate()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Group Scorecard_Usage" Then
sh.Visible = xlSheetHidden
End If
Next sh
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Address
Case "$D$10"
Sheets("John C - Total Applicants").Visible = True
Sheets("John C - Total Applicants").Activate
Case "$D$11"
Sheets("Doug D - Total Applicants").Visible = True
Sheets("Doug D - Total Applicants").Activate
Case "$D$12"
Sheets("Lesia - Total Applicants").Visible = True
Sheets("Lesia - Total Applicants").Activate
Case "$D$13"
Sheets("Jim Elder - Total Applicants").Visible = True
Sheets("Jim Elder - Total Applicants").Activate
Case "$D$14"
Sheets("Kevin Byrnes - Total Applicants").Visible = True
Sheets("Kevin Byrnes - Total Applicants").Activate
Case "$D$15"
Sheets("Chelsea W - Total Applicants").Visible = True
Sheets("Chelsea W - Total Applicants").Activate
Case "$E$10"
Sheets("Total_Candidates_Scott").Visible = True
Sheets("Total_Candidates_Scott").Activate
Case "$E$11"
Sheets("Total_Candidates_Doug").Visible = True
Sheets("Total_Candidates_Doug").Activate
Case "$E$12"
Sheets("Total_Candidates_Lesia").Visible = True
Sheets("Total_Candidates_Lesia").Activate
Case "$E$13"
Sheets("Total_Candidates_Jim Elder").Visible = True
Sheets("Total_Candidates_Jim Elder").Activate
Case "$E$14"
Sheets("Total_Candidates_Mark").Visible = True
Sheets("Total_Candidates_Mark").Activate
Case "$E$15"
Sheets("Total_Candidates_Chelsea").Visible = True
Sheets("Total_Candidates_Chelsea").Activate
Case "$G$10"
Sheets("Unreviewed Applicants - Scott Z").Visible = True
Sheets("Unreviewed Applicants - Scott Z").Activate
Case "$G$11"
Sheets("Unreviewed Applicants - Doug").Visible = True
Sheets("Unreviewed Applicants - Doug").Activate
Case "$G$12"
Sheets("Unreviewed Applicants - Lesia O").Visible = True
Sheets("Unreviewed Applicants - Lesia O").Activate
Case "$G$13"
Sheets("Unreviewed Applicants - Jim").Visible = True
Sheets("Unreviewed Applicants - Jim").Activate
Case "$G$14"
Sheets("Unreviewed Applicants - Mark").Visible = True
Sheets("Unreviewed Applicants - Mark").Activate
Case "$C$21”"
Sheets("Scott_Hires_wo_ps").Visible = True
Sheets("Scott_Hires_wo_ps").Activate
Case "$C$22”"
Sheets("Doug_Hires_wo_ps").Visible = True
Sheets("Doug_Hires_wo_ps").Activate
Case "$C$23”"
Sheets("Lesia_Hires_wo_ps").Visible = True
Sheets("Lesia_Hires_wo_ps").Activate
Case "$C$24”"
Sheets("Jim_Hires_wo_ps").Visible = True
Sheets("Jim_Hires_wo_ps").Activate
Case "$C$25”"
Sheets("Mark_Hires_wo_ps").Visible = True
Sheets("Mark_Hires_wo_ps").Activate
Case "$C$26”"
Sheets("Chelsea_Hires_wo_ps").Visible = True
Sheets("Chelsea_Hires_wo_ps").Activate
Case "$D$21”"
Sheets("Scott_non_scheduled_inpersons").Visible = True
Sheets("Scott_non_scheduled_inpersons").Activate
Case "$D$22”"
Sheets("Doug_non_scheduled_inperson").Visible = True
Sheets("Doug_non_scheduled_inperson").Activate
Case "$D$23”"
Sheets("Lesia_non_scheduled_inpersons").Visible = True
Sheets("Lesia_non_scheduled_inpersons").Activate
Case "$D$24”"
Sheets("Jim_non_scheduled_inperson").Visible = True
Sheets("Jim_non_scheduled_inperson").Activate
Case "$D$25”"
Sheets("Mark_non_scheduled_inpersons").Visible = True
Sheets("Mark_non_scheduled_inpersons").Activate
Case "$D$26”"
Sheets("Chelsea_ns_inpersons").Visible = True
Sheets("Chelsea_ns_inpersons").Activate
Case "$E$21”"
Sheets("Scott_nc_inpersons").Visible = True
Sheets("Scott_nc_inpersons").Activate
Case "$E$23”"
Sheets("Lesia_nc_inpersons").Visible = True
Sheets("Lesia_nc_inpersons").Activate
Case "$E$26”"
Sheets("Chelsea_nc_inpersons").Visible = True
Sheets("Chelsea_nc_inpersons").Activate
Case "$F$22”"
Sheets("Doug_Reference_Checks").Visible = True
Sheets("Doug_Reference_Checks").Activate
Case "$F$23”"
Sheets("Lesia_Reference_Checks").Visible = True
Sheets("Lesia_Reference_Checks").Activate
Case "$F$24”"
Sheets("Jim_Elder_Reference_Checks").Visible = True
Sheets("Jim_Elder_Reference_Checks").Activate
Case "$F$25”"
Sheets("Mark_Reference_Checks").Visible = True
Sheets("Mark_Reference_Checks").Activate
Case "$F$26”"
Sheets("Chelsea_Reference_Checks").Visible = True
Sheets("Chelsea_Reference_Checks").Activate
Case "$G$23”"
Sheets("Lesia_BGCs").Visible = True
Sheets("Lesia_BGCs").Activate
Case "$G$25”"
Sheets("Mark_BGCs").Visible = True
Sheets("Mark_BGCs").Activate
Case "$G$26”"
Sheets("Chelsea_BGCs").Visible = True
Sheets("Chelsea_BGCs").Activate
End Select
End Sub
I'm trying to get a handle on what I'm doing incorrectly. Any help would be tremendously appreciated.
You should never, ever have to write different lines of code for each bit of data you might get. This is the opposite of the purpose of coding.
I suspect there's relevant data in columns A & B that you haven't included... like perhaps, the person's name, in column A perhaps? If not, do that (insert a column if necessary). Pick a naming convention and stick with it. (ie., hyphens, underscores or spaces, not a combination) You'll save yourself (and others) a lot of headaches.
Avoid super-long sheet names. They're hidden anyway so you can make them simpler and more standard. Perhaps: APP, CAN, UNR, WOP, NSI, NCI, REF, BGC.
Why do all these sheets need to be hidden? It's not preventing people from accessing them. Perhaps it's because there's just too darn many of them that it's cluttered? Instead of hiding/showing them constantly you might as well hide all the tabs with:
ActiveWindow.DisplayWorkbookTabs = False
After these changes, you could replace almost all your code with a couple lines similar to:
personName = cells(Target.Row,1)
Sheets(personname & "NSI")
I bet there are hours spent on maintaining this workbook every week. If this data is at all important, what you really should do is revamp is=t completely.
Ideally, you would move it to Microsoft Access since it's made for managing databases (as opposed to creating your own database in Excel). Even if you've never used Access, you'd still find it simpler than what you're doing here.
Short of that, at the very least: put all of this data on one tab. Excel has numerous simple to use features for filter and analyzing data that are useless when you split up the data like this. Keep it all together and make Excel do the work of display what you want, when you want. You're attempting to create functionality from scratch, that Microsoft perfected for you a long time ago. AutoFilter, Grouping, Pivot Tables could all save you so much time and make this workbook easier for everyone else to use.
It would be a good idea to learn Excel's built-in worksheet functionality inside and out before trying to get into VBA. There are a ton of great (free/easy) resources and forums out there that could help you, and I guarantee you'd be glad you did.
One indication that you might be getting ahead of yourself, happens to also be the solution your actual question..
"...works perfectly fine for range D10:G15, but doesn't work for cell range C21:G26..."
Details Matter.
So, you know something changes between G15 and C21. It makes sense to inspect that part of the code closely.
First off, there is no G15 -- but besides that, if we look closely:
...looking even closer:
Beginning there, until the end of your code, you somehow switched to the wrong type of quotation mark on half of your functions.
Final couple tips that will help prevent problems like this:
Put, as the first line of every module: Option Explicit. This will force you to properly declare and handle variables, properties, and more.
Before making changes, BACKUP. If you're making 10 major changes in a day, you should keep all 10 versions, for at least a few weeks. You'd be surprised how handy they come in, especially while learning.
Test your code after every change you make. It might seem time consuming, but this is an example of how it would have saved time in the long run.
I hope didn't sound like I'm insulting you or your work, and it's definitely not my intention to discourage you from learning, but it is very important to be 100% thorough, accurate and organized in this field, and to understand a skill completely before moving on to the next one, especially in the earlier stages. Be sure to check out some of the other great Excel forums out there too. Good luck!
Edit: Example solution
This is an example of what a difference some basic organization would make. The code below has the same functionality of all of the code in the question (except this one's bug free, error handling, and automatically adaptable to new names/reports).
Required Assumptions/Organization:
Column A contains the the manager name (worksheet name suffix): FirstName LastInitial ex. Jim E is in A13 and A24
Rows 9 & 20 are hidden and contain the "report code" (worksheet name prefix) : ex. D9 = TotApp & G20 = RefChk
Worksheets are renamed accordingly (ex: TotApp Jim E, RefChk Jim E)
Therefore we have simple logic:
worksheet prefix is always column A of the clicked row.
if row is between 10-15 then row 9 of clicked column contains suffix.
if row is between 21-26 then row 20 of clicked column contains suffix.
therefore, the entire clickable range is C10:G15 and C21:G26
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim destSht As String
'make sure double-clicked cell is within range
If Application.Intersect(Range("C10:G26"), Target) Is Nothing Then
Cancel = True 'cancel the double-click
Exit Sub
End If
'find the worksheet name suffix
Select Case Target.Row
Case 10 - 15
destsht = Cells(9, Target.Column)
Case 21 - 26
destsht = Cells(20, Target.Column)
Case Else
Cancel = True 'cancel the double-click
Exit Sub
End Select
'find the worksheet name prefix
destsht = Cells(Target.Row, 1) & destsht
'Unhide & activate worksheet
With Worksheets(destsht)
.Visible = True
.Activate
End With
End Sub
Length: 700 char (compared to 4700 char) (1/7th the size of the original)
Related
I've searched and searched the internet and all of the forums and I've been piecing together code and still can't figure this out. I've tried For loops and For Each loops and still can't get it right. In my sheet, I have all of my dates in Column D. I want to hide rows by month. I want to be able to click a macro button and only show dates in January, or February, or etc.
This is what I currently have:
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
End If
If cell.Value < "1/1/2018" Or cell.Value > "1/31/2018" Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
When I run this, it just hides anything that isn't an empty cell. I've cycled between defining cell as a Range and as a Variant and it's the same either way.
ETA:
It is working now and it took help from everybody. I really appreciate it! Here's what I ended with..
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
ElseIf cell.Value < CDate("1/1") Or cell.Value > CDate("1/31") Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
I removed the years from the code so that I don't have to change any coding for future years.
Your current setup would qualify all dates as either < or > the respective date comparison.
If you are trying to hide rows for January in this code, then you need to use AND instead of OR
And be sure you use >= & <= to include those first and last dates.
If cell >= "1/1/2018" AND cell <= "1/31/2018" Then
If you are trying to hide rows not January then your < and > are transposed:
If cell < "1/1/2018" OR cell > "1/31/2018" Then
Alternative approach: If you've got Excel 2013 or later, simply add a Table Slicer and filter on a MONTH column generated with =DATE(YEAR([#Date]),MONTH([#Date]),1) as shown below:
Or otherwise use a PivotTable and a Slicer:
To see how easy it is to set up a PivotTable, see VBA to copy data if multiple criteria are met
Ultimately, I believe this is the code you're looking for:
Sub January()
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Date")
'If date falls on or after January 1, AND on or before January 31, don't hide the row
If cell.Value >= CDate("1/1/2018") And cell.Value <= CDate("1/31/2018") Then
cell.EntireRow.Hidden = False
Else
'If the cell doesn't contain anything or isn't in January, hide the row
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
End Sub
You need to use And logic, not Or logic. Or logic always returns TRUE unless both expressions are false or there is a null involved. Because of this, the code stopped looking at your logical statement once it evaluated to true since every date you had - I'm assuming - fell after January 1, 2018. This in turn caused the rows to hide unexpectedly.
Additionally, I would convert the strings you have into dates using CDate. It helps Excel understand what is going on a bit better and makes your code easier to understand to outsiders. Another good practice to work on is adding comments to code. I think we've all learned the hard way by leaving comments out of code at some point or another.
One last thing: if you're planning to have buttons for each month, consider doing one procedure for all of them and having variables populate the date ranges, potentially using input boxes to get the values from the user. It'll save you a lot of headaches if you ever decide to change things up in the future.
Untested, written on mobile. I am just providing an alternative approach which tries to use MONTH and YEAR. Some may find this approach easier to understand.
Option Explicit
Sub January()
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = (Month(cell.Value) = 1) and (year(cell.Value) = 2018)
End if
Next cell
End sub
I will actually go with Slicers and Table.
But if you call VBA your neat solution then I'd say abandon the loop.
Have nothing against it but if Excel already have the functionality, then use it.
It is like a discount or a promotion that we need to take advantage of.
So instead of loop, why not just filter?
Dim lr As Long, r As Range
With Sheet1 '/* sheet where data reside */
.AutoFilterMode = False '/* reset any filtering already applied */
lr = .Range("D" & .Rows.Count).End(xlUp).Row '/* get the target cells */
Set r = .Range("D1:D" & lr) '/* explicitly set target object */
'/* filter without showing the dropdown, see the last argument set to false */
r.AutoFilter 1, ">=2/1/2018", xlAnd, "<=2/28/2018", False
End With
Above is for February of this year, you can tweak it to be dynamic.
You can create separate sub procedure for each month of you can just have a generic one.
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
I have large table with values in range H2:PIG2202. I need to compare the first rows H2:PIG2 values with all other rows values. And if there is a match in the result table it pastes just those values which matched.
Now I'm using this formula in the result table to display needed values:
=IF(sheet!H$2=sheet!H3;IF(AND(sheet!H3;ISBLANK(sheet!H3))=FALSE;sheet!H3;"");"")
The VBA code is:
Sub find()
Application.ScreenUpdating = False
Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Application.ScreenUpdating = True
End Sub
The problem is that Excel shows an error when I run this macros that there are not enough system resources.
Also I would like that in the result table would be just values, not formulas.
Is that possible to do? I have no idea how to achieve this :(
Thank you in advance!
Quick solution for your which is not sophisticated and I'm rather not proud of it (but it was quickest to prepare). Keep in mind that you are going to run it 24m times which could take several minutes, maybe an hour. Some comments inside the code.
Sub Solution()
Application.ScreenUpdating = False
'-----previous one
'Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
'----- new one- inserting values- first idea, simple code
Dim Cell As Range
'run for one row first to check if it is ok! and check time needed per row
'next change range to one you expect
'next- take a cup of coffee and relax...
For Each Cell In Range("h2:PIG2")
Cell.FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Cell.Value = Cell.Value
'to trace progress in Excel status bar
Application.StatusBar = Cell.Address
Next Cell
Application.ScreenUpdating = True
End Sub
I have an interesting issue. I've tried searching this site and Google but there are only slightly related problems, none which actually address this specific need.
I have a spreadsheet with 10 columns (let's call them A-J). I need to delete all the rows that do NOT have a value of "30", "60", "90", "120" or blank within the cells of column H.
Though there are many ways of doing this, all of them have relied on loops, which doesn't work for me as this dataset has over 25k rows and it takes 10+ minutes to run - too long.
I've been looking at autofilter options in conjunction with the .Find function (e.g. find all rows with H cells that don't meet the criteria and delete) but AutoFilter on 2003 only works with 2 criteria, while I have 5 to check against. I'm not sure how to proceed.
Any help is appreciated.
This deleted all matching rows (~10%) in a sample of 25k rows in 20sec
Sub tt()
Dim rw As Range
Dim all As Range
Dim t
Dim b As Boolean
t = Timer
For Each rw In Range("A1").CurrentRegion.Rows
If rw.Cells(8).Value < 1 Then
If b Then
Set all = Application.Union(rw, all)
Else
Set all = rw
b = True
End If
End If
Next rw
If not all is nothing then all.EntireRow.Delete
Debug.Print "elapsed: " & Timer - t
End Sub
You can try Advanced Filter option where you can give more than two criteria to filter the list. After filtering the list matching the criteria you set, the filtered list can be copied to another location (option available) and the remaining deleted.
You can add a column with the condition of your own:
=IF(OR(H1=30;H1=60;H1=90;H1=120;H1="");"DELETE";"")
(the formula is given for row 1, you have to copy-paste it to the entire range)
Then use filtering and sorting to select the rows to delete.
Some speed tips:
When using large data, assign values to array and use array instead of *.Value;
When working with full columns, ignore empty columns at bottom;
When making intensive changes in worksheet, disable screen update and automatic calculation.
Stating this, I would use this code:
Sub Macro1()
Dim su As Boolean, cm As XlCalculation
Dim r As Long, v(), r_offset As Long
su = Application.ScreenUpdating
Application.ScreenUpdating = False 'Disable screen updating
cm = Application.Calculation
Application.Calculation = xlCalculationManual 'Disable automatic calculation
'Only use used values
With Intersect(Range("H:H"), Range("H:H").Worksheet.UsedRange)
v = .Value 'Assign values to array
r_offset = .Row - LBound(v) 'Mapping between array first index and worksheet row number
End With
'Check all row from bottom (so don't need to deal with row number changes after deletion)
For r = UBound(v) To LBound(v) Step -1
Select Case v(r, 1)
Case "30", "60", "90", "120", Empty 'Do nothing
Case Else
Sheet1.Rows(r + r_offset).EntireRow.Delete
End Select
Next
Application.ScreenUpdating = su 'Restore screen updating
Application.Calculation = cm 'Restore calculation mode
End Sub
Thanks to all who've suggested solutions. In the between time I ended up figuring out a way to do this in <1 second - apparently I myself didn't realise that AutoFilter could've supported comparison criteria (greater than, less than etc).
Using a series of autofilters I simply filtered for, then deleted all rows that filtered to "<30", "30120".
Not elegant, but it did the trick.
I am having difficulties with this code. I am trying to make it so that based on the value of cell D25 the value of F25 will change. I made the code in VBA (don’t know if this is actually the best way) and it is giving me a 424 runtime error: Object Required. Could someone please point me in the right direction?
Sub Storage_vesel_Controle()
Sheets("NSR Form").Select
If Range("D25") = "1" Then Range("F25").Select.Value = "0"
If Range("D25") = "2" Then Range("F25").Select.Value = ".95"
If Range("D25") = "3" Then Range("F25").Select.Paste = ".98"
End Sub
Also, what do I need to add to make the code "always running"... in loop I think?
Further to my comment above, I wasn't planning on posting an answer but saw few things which I think I will bring to your notice and comments wouldn't accommodate so much of text.
I would recommend not using .Select to select the sheet but work with the sheet directly (See Below code) You might also want to see this link
Sub Storage_vesel_Controle()
With Sheets("NSR Form")
Select Case .Range("D25").Value
Case 1: .Range("F25").Value = 0
Case 2: .Range("F25").Value = 0.95
Case 3: .Range("F25").Value = 0.98
End Select
End With
End Sub
EDIT:
Regarding your edit. You can use the Worksheet_Change Event to ensure that the values of F25 gets automatically updated or if you want a non VBA solution then simply use a Formula in F25
If you are interested in Worksheet_Change then see this. Else a simple formula like this in F25 will suffice your needs :)
=IF(D25=1,0,IF(D25=2,0.95,IF(D25=3, 0.98,"")))
Clean it up a little bit. Using a Select Case statement will be easier to work with than mutliple If/Then statements.
Sub Storage_vesel_Controle()
With Sheets("NSR Form")
.Activate '<this line is not actually necessary unless you want to be on the sheet.
Select Case .Range("D25").Value
Case 1
.Range("F25").Value = 0
Case 2
.Range("F25").Value = 0.95
Case 3
.Range("F25").Paste = 0.98
Case Else
'do nothing, or, modify as needed
End Select
End With
End Sub