Excel VBA code to select all cells with data sometimes working - vba

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

Related

Runtime error 1004 - The command cannot be used on multiple selections

The code below copies data from a specific column and transfers it to another one. For example, if in column A I have data from row 1 to 10 and press the button, then the values from row 1 to 10 will be transferred to i.e. column D. Afterwards, If I change the values in row 5, 7 and 9 in column A and press the button, only the values from row 5, 7 and 9 will be transferred to column D. The reason why the code is like that is because the worksheet has many rows filled with values and I want to be transferred (copy) only the values that have been modified. Otherwise, it will take quite some time.
The code works, but sometimes I get the error The commnand cannot be used on multiple selections. I tried to have a look on the internet to fix it but I couldn't come up with any solutions. Any help will be appreciated!
Note: A user from this community helped me to write the code below a time ago, but I cannot find the link anymore for that.
This code is pasted in the worksheet that I am using:
Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)
Dim creation As Worksheet
Set creation = ActiveSheet
Dim copydata As Range
Set copydata = Application.Intersect(target, creation.Range("A2:A5000", "A" & creation.Rows.Count))
If (Not copydata Is Nothing) Then
If (CopyDataRange Is Nothing) Then
Set CopyDataRange = copydata
Else
Set CopyDataRange = Application.Union(CopyDataRange, copydata)
End If
End If
End Sub
And this code is pasted in a module:
Option Explicit
Public CopyDataRange As Range
Public Sub CommandButton1_Click()
Application.ScreenUpdating = False
If (Not CopyDataRange Is Nothing) Then
CopyDataRange.Copy
CopyDataRange.Offset(0, 3).PasteSpecial Paste:=xlPasteValues ' this where I get the error
Set CopyDataRange = Nothing
End If
Application.ScreenUpdating = True
End Sub
PasteSpecial doesn't work on multiple ranges. You can loop over all parts of the range using the Areas property:
if Not CopyDataRange Is Nothing then
Dim r As Range
For Each r In CopyDataRange.Areas
r.Copy
r.Offset(0, 3).PasteSpecial Paste:=xlPasteValues
Next
set CopyDataRange = nothing
end if
This will work even if you don't have a multiple range, in that case it contains only one Area (Areas.Count = 1)

Excel | autostart macro on cell value change | cause crash

first of all I'm not a VBA programmer but typically an end-user who uses snippets of code that I gather in forums like this in his spreadsheets, trying to understand what the code does. Code for which I thank you all!
My objective:
I have a spreadsheet that is basically an input-form for users.
Based on their input and selections via dropdown my intention is to guide them through the form by hiding & unhiding rows with input fields, presenting the users with the relevant questions.
On each row I have created an IF-formula that creates a 1 or 0 based on previous provided input
1 -> unhide the row , 0 -> hide the row.
So I'm looking for a macro that runs with every sheet calculation and hides or unhides the next rows as needed.
These formulas are in range I3:I70 on top of that I created a summary field in I2 =sum(I3:I70) so i thought I can either check changes in the range I3:I70 or changes on cell I2 to trigger the macro. [Neither solution fixed my problem]
I've tried several code examples discribed on the forums and I've tested the macros that checks for change in the range or the cell individually.
As long as I call a test macro with a MsgBox it works fine.
Also the macro that hides or unhides runs fine when I call it manually.
My problem:
When I let the 'auto'-macro call the 'hide'-macro, Excel simply crashes; no warnings, nothing --> just crash.
My code:
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("H3:H70")
If Not Intersect(Xrg, Range("H3:H70")) Is Nothing Then
Macro1
End If
End Sub
Sub Sample()
MsgBox "Yes"
End Sub
Sub Macro1()
Dim cell As Range
For Each cell In Range("H3:H70")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
If cell.Value = 1 Then
cell.EntireRow.Hidden = False
End If
End If
Next
End Sub
Thanks for any suggestions and tips in advance.
JeWe
Never give up searching :-) I gave it a last search and found some code on the microsfof dot com site that seems to work.
Don't ask me the details but this seems to do what i'm looking for
Private Sub Worksheet_Calculate()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
On Error Resume Next
For Each c In Range("H3:H70")
If c.Value = 0 Then
c.EntireRow.Hidden = True
ElseIf c.Value = 1 Then
c.EntireRow.Hidden = False
End If
Next
On Error GoTo 0
Application.EnableEvents = True
End Sub
It's late on my end of the world, going to sleep. Will update tomorrow.
Txs JeWe

VBA set cell value after .ClearContents

Why does the cell value not set in another function when clearing the contents of the range in another function?
I'm trying to set a cell value to "All" after clearing the cells in the range. I've even tried to get a message box to pop up to see if i can somehow check if my check value is correct.
DelRange is the range i'm clearing.
Building is the cell that i'm checking the value for and if it's blank, it needs to change to "All".
clearPreviw is used to clear another sheet, which it's doing.
Sub ClearSheet()
Dim Dash As Worksheet
Dim DelRange As Range
Dim Building As Range
Set Dash = ActiveWorkbook.Worksheets("DASH")
Set DelRange = Dash.Range("FilterData")
Set Building = Dash.Range("SelBuild")
DelRange.ClearContents
Call clearPreview
'This part below doesn't work when the Range.ClearContents has been done, but doing it on it's own without clearing the range works fine
If Building.Value = "" Then
MsgBox "Building is empty", vbOKOnly
Building.Value = "All"
End If
End Sub
I've run this test as a separate process which works, but once again when running it as a call function right after .ClearContents seems to stop this.
Sub test()
Dim Dash As Worksheet
Dim DelRange As Range
Dim Building As Range
Set Dash = ActiveWorkbook.Worksheets("DASH")
Set DelRange = Dash.Range("FilterData")
Set Building = Dash.Range("SelBuild")
If Building.Value = "" Then
MsgBox "Building is empty", vbOKOnly
Building.Value = "All"
End If
End Sub
I've been poking at it and searching but i can't wrap my head around this.
I think you are missing:
Building.ClearContents;
Also I would prefer:
If IsEmpty(Building.Value) Then
over:
If Building.Value = "" Then
This link gives you a good start on how to set range variables (although I would advice you against the use of .Select and .Activate).
After that, use .ClearContents or .Clear, depending on your needs.
If you properly cleared the ranges, there is no need to check if they are empty, so this might be a redundant step within your current planning.

error '1004': Select method of Range class failed

I am sure that every person who reads the title would say "oh no, not again". But before posting this, I have read about 7-8 previous questions with similar title and no-one seemed to work. So this is the deal:
My workbook uses the Workbook_Open event to show a userform:
Sub Workbook_Open()
UserForm1.Show
End Sub
Userform1 includes a textbox and a listbox. The listbox is populated with data dynamically, according to user's typing in the textbox. So far everything ok.
When user clicks at a value inside the listbox, I want a specific cell to be selected. So I used this:
Private Sub ListBox1_Click()
Dim Cell As Range
With ThisWorkbook.Worksheets(1)
Set Cell = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Find(UserForm1.ListBox1.Text, LookIn:=xlValues)
.Range(Cell, Cell.Offset(0, 2)).Select
End With
End Sub
But as many others before me, I cannot make Select work properly and this code gave an error like the title.
I tried several things to make this code work.
-Tried Application.GoTo, using it instead of Select,as someone suggested.
-Tried to move the code of the ListBox1_Click event to a sub inside a standard module and call this sub with the ListBox1_Click event.
-Tried to select the worksheet first as others suggested.
-Tried Worksheets(1).Visible = True as someone else suggested.
-Tried to activate the main window of the application first with AppActivate Application.Caption.
-Tried to scroll to the desired cell instead of selecting:
Private Sub ListBox1_Click()
Dim foundRow As Integer
With ThisWorkbook.Worksheets(1)
foundRow = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Find(UserForm1.ListBox1.Text, LookIn:=xlValues).Row
End With
ActiveWindow.ScrollRow = foundRow - 1
End Sub
I also tried other less important changes but I'm stuck with it. The funny thing is that before using the Workbook_Open event, I had UserForm1 shown via a macro assigned to a button/shape in the worksheet and everything worked fine then.
Does anybody know how am I going to make Select work in my case?
On the other hand, it's well understood that Select causes a great deal of problems, so I'm not stuck with it. If anyone has a another way to have the same result I'm all ears.
I was able to replicate the issue, first of all I followed what you described, made a list and picked from it to see if would scroll into view, and it worked.
If I closed the form, changed the active sheet. and then run the form it failed with the error message you are seeing.
Trying a number of things I discovered you can't select a cell if it is not the active sheet (which is logical, a user can not click on a cell that is not on the sheet they are viewing)
The below Activate line should fix it.
Private Sub ListBox1_Click()
Dim Cell As Range
With ThisWorkbook.Worksheets(1)
Set Cell = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Find(UserForm1.ListBox1.Text, LookIn:=xlValues)
ThisWorkbook.Worksheets(1).Activate
.Range(Cell, Cell.Offset(0, 2)).Select
End With
End Sub
As noted by #ScotCraner and as shown in the sample code on MSDN you should first check if something has been found before using / showing it.
The following should work flawlessly:
Private Sub ListBox1_Click()
Dim Cell As Range
Application.DisplayStatusBar = True
With ThisWorkbook.Worksheets(1)
Set Cell = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Find(UserForm1.ListBox1.Text, LookIn:=xlValues, LookAt:=xlWhole)
If Not Cell Is Nothing Then
Application.StatusBar = "Found " & UserForm1.ListBox1.Text
.Activate
.Range(Cell, Cell.Offset(0, 2)).Select
Else
Application.StatusBar = "Couldn't find " & UserForm1.ListBox1.Text
End If
End With
End Sub
Note, that you are using UserForm1.ListBox1.Text which does not consider UserForm1.ListBox1.MultiSelect.

Unlock cell on a condition from adjacent cell

I have two columns but the codition I would like is to be evaluated from one cell to another.
The first column has cells which have a drop down validation with names, and the second will activate only if a certain name from the adjacent cell is selected.
so far i only found this code but it does not seem to work:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Car" Then
Range("B1").Locked = False
Else
Range("B1").Locked = True
End If
End Sub
I would need this code go from (for example) A1:A10 and B1:B10.
I hope I am making sense. If there is a way to do it without VBA, that would be great.
Thanks for the help.
The Target parameter tells you the range that is being changed.
You need to do something like the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A1:A10"), Target)
If rng Is Nothing Then
' Not updating the range we care about
Exit Sub
Else
rng.Offset(0, 1).Locked = ... whatever ...
End If
End Sub
Note that your target range can be more than one cell (e.g. when using copy/paste), so you need to handle and test this case.
Calling Intersect returns you the intersection of the target range and the range you are interested in testing (A1:A10 in this sample).
You can then access the corresponding adjacent cell(s) using .Offset(0,1)
That code snippet works perfectly for me.
Did you place that code in the proper WorkSheet object? It won't work if you just put it into a VBA module. When you are in the Visual Basic Editor, look for a directory on the left side of the screen labeled "Microsoft Excel Objects". In that directory should be a WorkSheet object for every sheet in your file. Double-click on one of these to edit the code for that WorkSheet. This is where your code snippet should go.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Car" Then
Range("B1").Locked = False
Me.Unprotect ("password")
Else
Range("B1").Locked = True
Me.Protect ("password")
End If
End Sub
Use Me.Protect so the .Locked method does something. You should probably unlock every other cell though.