At this point there are two problems, but the first one i want to deal with is that i cannot get the paste function to work. When I run through the code the specific cells are highlighted to copy (the cell border is b&w flashing) and the cells where they are to end up are now highlighted, but nothing pastes.
Sub OtherTask()
Dim DRng As Range
ActiveSheet.Range("g2:ah2").find(Date).Select
ActiveCell.Resize(5).Offset(5).Select
Selection.AutoFilter field:=1, Criteria1:="1", Operator:=xlFilterValues
Set DRng = ThisWorkbook.ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
DRng.Copy
ActiveSheet.Range("r12").PasteSpecial xlPasteAll
If ActiveSheet.AutoFilterMode = "True" Then
ActiveSheet.AutoFilterMode = "False"
End If
End Sub
I should bring up the second problem. When I execute this from the macro button it performs as per the description above, but when I am in the editor and I press the play button I get error 91 that the object is not set. Not sure why I would get the error with one form of execution and not the other?? Looking through similar perhaps I should be using value instead of copy? Thanks for any help.
I had to make some assumptions with your code because there are some things that are not that clear. The assumptions should be easy to see and to change according to your needs.
Sub OtherTask()
Dim ws as Worksheet
Dim DRng As Range
Set ws = Worksheets("mySheet")
With ws
Dim rFound as Range
Set rFound = .Range("g2:ah2").find(Date)
rFound.Resize(5).Offset(5).AutoFilter field:=1, Criteria1:="1", Operator:=xlFilterValues
'declare this range explicitly, whatever it is
Set DRng = .Range("A1:B5000").AutoFilter.Range.SpecialCells(xlCellTypeVisible)
DRng.Copy .range("R12") 'since you paste everything just do straight from copy method
If .AutoFilterMode = "True" Then .AutoFilterMode = "False"
End With
End Sub
Related
I have a macro that I call when the workbook closes. It checks the columns in two tables on separate worksheets and assigns row numbers based on what it finds.
Worksheet_Change handler is located on the sheet with Projects range. Database range is located on another worksheet in the same workbook.
Whenever I call the macro anywhere else, it either generates an error or causes an usual bug where excel is partially frozen (anyone know what the hell this is?!?!?!).
Anyway, my last resort before giving up is to change the macro into a worksheet change event and I was wondering if I could get some help creating this.
The original macro:
Sub FindRow()
'This module verifies row numbers in the database by matching them to the opportunities in the Projects
'worksheet. It then assigns row numbers in the Projects worksheet.
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Application.ThisWorkbook.Sheets("Projects").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundRng As Range
For Each rng In Sheets("Projects").Range("B2:B" & LastRow)
Set foundRng = Sheets("Database").Range("C:C").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
If Not foundRng Is Nothing Then
rng.Offset(0, -1) = foundRng.Row
End If
Next rng
Application.ScreenUpdating = True
End Sub
My proposed change:
Public Sub Worksheet_Change(ByVal Target As Range)
Dim Records As Range
Set Records = Range("Records")
If Not Application.Intersect(Records, Range(Target.Address)) Is Nothing Then
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Application.ThisWorkbook.Sheets("Projects").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundRng As Range
For Each rng In Sheets("Projects").Range("B2:B" & LastRow)
Set foundRng = Sheets("Database").Range("C:C").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
If Not foundRng Is Nothing Then
rng.Offset(0, -1) = foundRng.Row
End If
Next rng
Application.ScreenUpdating = True
End If
End Sub
However, I keep getting an error on the line that defines the variable LastRow.
I get an application-defined error even though everything is defined properly before.
Thanks in advance.
Worksheet_Change handles is located on the sheet with Projects range. Database range is located on another worksheet in the same workbook. – Remi 1 min ago
This means rng is also on the Projects sheet:
For Each rng In Sheets("Projects").Range("B2:B" & LastRow)
(BTW Me.Range("B2:B" & LastRow) would have been much less ambiguous here)
You're handling a Worksheet_Change event on the Projects sheet, which Excel fires whenever a cell value changes on the Projects sheet. Then inside that handler, you do this:
rng.Offset(0, -1) = foundRng.Row
With rng being a range on the Projects sheet, you're entering a recursive cycle of sheet changes, and that is likely what's crashing your code.
When you make worksheet changes while handling worksheet changes, you need to tell Excel "it's okay, I got this", by preventing it from re-firing the Worksheet.Change event every time:
Application.EnableEvents = False
'...code...
Application.EnableEvents = True
Moreover, when you toggle Application.ScreenUpdating = False, you're telling Excel "don't repaint yourself until I say so" - that can speed things up considerably, in a lot of cases, however it also means you need to toggle it back on manually if something bad happens.
You can avoid this by implementing an error handler - here's the principle:
Sub DoSomething()
On Error GoTo CleanFail
Application.EnableEvents = False
Application.ScreenUpdating = False
'...code...
CleanExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
CleanFail:
Debug.Print Err.Description
Stop
Resume CleanExit
Resume 'F8 takes you to the error-throwing statement
End Sub
You have not indicated what sheet is the activesheet that has the worksheet_change event.
Any way, here is a code to find the last row in column B sheet "Projects"
Dim LastRow As Long, sh As Worksheet
Set sh = Sheets("Projects")
LastRow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
MsgBox LastRow & " is the last row in Column B Sheet Projects!"
I'm copying values as part of one sub process and pasting value through an update button on userform.
To copy values:
Private Sub Month1_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks.Open("Place on drive")
Set wks = wkb.Sheets("Training1")
wks.Range("Start:Finish").Copy
wkb.Close
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.ScreenUpdating = True
End Sub
To paste values in current sheet:
Private Sub UpdateActuals_Click()
For i = 1 To 12
If Me.Controls("Month" & i).Value = True Then
ThisWorkbook.Sheets("2017 Actuals").Range(i+1, 5).PasteSpecial xlPasteValues
End If
Next i
End Sub
If I replace "i+1, 5" with "B5", it errors with
"PasteSpecial method of Range class failed".
I feel as if values copied in one sub process are not brought to second one, would that be correct?
Also, how do I reduce processing time given that I have 12 months (12 files) in various places that I can't change the location for...
Range usually likes a starting cell and an ending cell. I suggest since you are looking at just one cell that you change .Range to .Cells. If you really want to use a range with RC format, .Range(Cells(row1, col1), Cells(row2, col2)), if you want just one cell then you can make the two parts the same. I have run into problems before using Range and only one cell definition before, either make it .Cells for your target or fill out Range the way I have explained.. Cheers.
Dim 2017actWS AS Worksheet
Set 2017actWS = ThisWorkbook.Worksheets("2017 Actuals")
1)
2017actWS.Cells(i+1, 5).PasteSpecial xlPasteValues
-or-
2)
2017actWS.Range(2017actWS.Cells(i+1, 5), 2017actWS.Cells(i+1,5)).PasteSpecial xlPasteValues
When using Ranges excel will often throw errors if they are not the same size in a copy and paste, you can eliminate that by using a single cell as the starting target of your paste with .Cells
Also I don't see you call your function. You will want your paste close to your copy or you might find things get strange (suggestion: just after your copy).
Edited to be sure there is not worksheeet ambiguity. Thank you Scott C.
Cheers, WWC
I am setting a dynamic single column range, then looping through that Range to build a ColumnClustered graph.
If the Range has an empty cell looping through the .FullSeriesCollection throws an invalid parameter error. Error occurs at
With .FullSeriesCollection(I).
Is there any easy way around this? I would like to show that the empty cell exists, this is a time point, but does not exist for this particular parameter getting graphed.
Appreciate any help!
With Sheets(GSheet).ChartObjects.Add _
(Left:=100, Width:=200, Top:=75, Height:=150)
With .Chart
.ChartType = xlColumnClustered
'Set data source range.
.SetSourceData Source:=MyRange, PlotBy:=xlRows
For I = 1 To MyRange.Count
With .FullSeriesCollection(I)
' Do Stuff
End With
Next I
End With
End With
You'll need to assign MyRange only cells that contain a value. One way would be to use the Union method. Another way would be to use the SpecialCells method. Here's an example using the Union method, assuming that the source data is located in the first sheet, and in A2:A10...
Dim rCell As Range
Dim MyRange As Range
For Each rCell In Sheets(1).Range("A2:A10")
If Len(rCell) > 0 Then
If MyRange Is Nothing Then
Set MyRange = rCell
Else
Set MyRange = Union(MyRange, rCell)
End If
End If
Next rCell
Also, you should test whether MyRange has been assigned any cells...
If Not MyRange Is Nothing Then
'Create your chart
'
'
Else
MsgBox "No data found.", vbExclamation
End If
Hope this helps!
I once built a VBA button to automatically lock all cells with data in them. And it was working perfectly. Now I wanted to copy that button to another worksheet. So I created another button, copy and pasted the whole VBA over, then edited the worksheet names and range. And, it's only working like 5% of the time, the rest of the time, I'm getting an "Run-Time error '1004': No cells were found." I've tried a few fixed, changing Sheets to Worksheets, or adding a ", 23" to the specialcells argument. However, nothing is working right now. When I try stepping in, it sometimes say both rng and lckrng as empty, and sometimes only show lockrng as empty and not show rng at all. Problem is this used to be a working code, and now, it still works around 5% of time. Any idea why? Thank you very much!
Private Sub CommandButton1_Click()
Dim rng As Range
Dim lockrng As Range
Sheets("Uploading Checklist (M)").Unprotect Password:="signature"
Set rng = Range("A1:M14")
'Selecting hardcoded data and formulas
Set lockrng = Union(rng.SpecialCells(xlCellTypeConstants), rng.SpecialCells(xlCellTypeFormulas))
lockrng.Locked = True
Sheets("Uploading Checklist (M)").Protect Password:="signature"
End Sub
Maybe this is too simplistic, but it seems to do what you want. The animated .gif shows it working to "lock all cells with data in them". (I made the second button just for convenience). If nothing else it might be good to start from something like this that works and modify to suit your needs.
Dim cell As Range, sh As Worksheet
Sub Button4_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
For Each cell In sh.UsedRange
If cell <> "" Then cell.Locked = True Else cell.Locked = False
Next
sh.Protect Password:="s"
End Sub
Sub Button5_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
End Sub
The Union you are attempting will not work if either of the parameters is Nothing (i.e. you either have no constants in the range, or you have no formulas in the range).
Prior to doing the Union, you should check the parameters aren't Nothing but, once you start changing your code to do that, it would be just as simple to do the locking in two parts - so I recommend you rewrite the code as follows:
Private Sub CommandButton1_Click()
With Sheets("Uploading Checklist (M)")
.Unprotect Password:="signature"
With .Range("A1:M14")
'Lock any constants
If Not .SpecialCells(xlCellTypeConstants) Is Nothing Then
.SpecialCells(xlCellTypeConstants).Locked = True
End If
'Lock any formulas
If Not .SpecialCells(xlCellTypeFormulas) Is Nothing Then
.SpecialCells(xlCellTypeFormulas).Locked = True
End If
End With
.Protect Password:="signature"
End With
End Sub
I'm trying to loop through a range of cells, locking any cell that has content while leaving empty cells unlocked.
When I run the below code the result is the entire sheet is locked. If I add an else statement the sheet is unlocked. Basically whatever the last .locked = (true, false) statement is is how the entire sheet winds up.
Change 1 Is it possible that I have some setting on/off that is interfering since I'm the only one who is unable to get any of this to work?
Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range
'Clear the default status
ActiveSheet.Unprotect
Range("A7:I35").Locked = False
Set chRng = ActiveSheet.Range("A7:I35")
'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
If chCell.Value <> "" Then Cells.Locked = True
Next chCell
ActiveSheet.Protect
End Sub
Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range
ActiveSheet.Unprotect
Set chRng = ActiveSheet.Range("A7:I35")
'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
chCell.Locked = (chCell.Value <> "")
Next chCell
ActiveSheet.Protect
End Sub
You can try this.
Public Sub abc()
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Range("I8:I500, K8:K500, M8:M500, N8:N500").Cells.Locked = False
ActiveSheet.Protect Password:="1234"
End Sub
Check this out: http://www.mrexcel.com/archive/VBA/15950b.html
Sub CellLocker()
Cells.Select
' unlock all the cells
Selection.Locked = false
' next, select the cells (or range) that you want to make read only,
' here I used simply A1
Range("A1").Select
' lock those cells
Selection.Locked = true
' now we need to protect the sheet to restrict access to the cells.
' I protected only the contents you can add whatever you want
ActiveSheet.Protect DrawingObjects:=false, Contents:=true, Scenarios:=false
End Sub
If you say Range("A1").Select, then it locks only A1. You can specify multiple cells to be locked by specifying as follows:
A3:A12,D3:E12,J1:R13,W18
This locks A3 to A12 and D3 to E12 etc.
I may be missing something but...
Cells.Locked = True
...will lock all cells on the active sheet. If you just change it to...
chCell.Locked = True
...then it works; I think?! As the range is very small, you may as well not unlock cells at the start, and instead unlock cells whilst locking them e.g.
For Each chCell In chRng.Cells
If chCell.Value <> "" Then
chCell.Locked = True
Else
chCell.Locked = False
End If
Next chCell
If you are new to VBA, I would recommend cycling through code line-by-line as described in this Excel consultant's video. If you step through code, you can check "has cell A7 behaved as expected?"...instead of just seeing the end product
A quick way to unlock non-blank cells is to use SpecialCells see below.
On my testing this code handles merged cells ok, I think this is what is generating your error on Tim's code when it looks to handle each cell individually (which to be clear is not an issue in Tim's code, it is dealing with an unexpected outcome)
You may also find this article of mine A fast method for determining the unlocked cell range useful
Sub Quicktest()
Dim rng1 As Range
Dim rng2 As Range
On Error Resume Next
Set rng1 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlFormulas)
Set rng2 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlConstants)
On Error GoTo 0
ActiveSheet.Unprotect
ActiveSheet.Range("A7:I35").Cells.Locked = False
If Not rng1 Is Nothing Then rng1.Cells.Locked = True
If Not rng2 Is Nothing Then rng2.Cells.Locked = True
ActiveSheet.Protect
End Sub
I know this is an old thread, but I've been stuck on this for a while too, and after some testing on Excel 2013 here's what I conclude if your range includes any merged cell
The merged cells must be entirely included within that range (e.g. the merging must be entirely within the range being lock/unlocked
The range being merged can be larger, or at least exactly the range corresponding to the merged cells. If it's a named range that works as well.
Also, you cannot lock/unlock a cell that is already within a protected range. E.g if you run:
public sub test()
Sheet1.range("myNameRange").locked = true
Sheet1.protect
end sub
Twice it will work the first time, and fail the second time around. So you should unprotect the target range (or the sheet) before....
If you want to protect the specific cells of any specific excel without the password protection then here is the solution:
Sub ProtectingSheet()
Workbooks.Open (c\documents\....)
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
Worksheets(CellValue).Activate
mainworkBook.Sheets("Sheet1").Range("A1:AA100").Locked = True
Range(Cells(1, 2), Cells(1, 25)).Select
Selection.Locked = False
ActiveSheet.Protect
End Sub