Run time error 13 on For loop - vba

I am trying to use a combobox in my user interface, but if none of the options are good for the user they can type it in but after if they have entered something I want to save it so next time it appears in the list. I have tried the following approach:
For i = Range("O3") To Range("O3").End(xlDown)
If Not i.Value = ComboType.Value Then
Range("O3").End(xlDown) = ComboType.Value
End If
Next i
But this gives the above error on the first line. I am not very familiar with For loops in VBA so I am hoping somebody can help me.

This is how to make the for-each loop from O3 to the last cell with value after O3:
Public Sub TestMe()
Dim myCell As Range
Dim ws As Worksheet
Set ws = Worsheets(1)
With ws
For Each myCell In .Range("O3", .Range("O3").End(xlDown))
Debug.Print myCell.Address
Next myCell
End with
End Sub
It is a good practise to declare the worksheet as well, because otherwise you will always work with the ActiveSheet of the ActiveWorkbook.

Related

VBA How to fix: "Property or method is not supported with this object" when cell securing in multiple sheets

So bassicaly I want to secure a specific range within every sheet (same range always applies).
Code:
Sub desecure()
For x = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(x).Range("C7:P16").Protect Password:="30713"
Next
End Sub
Sub secure()
For x = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(x).Range("C7:P16").Protect Password:="30713"
Next
End Sub
It always give the error stated in the question. Anyone knows how to fix this? (or a alternative)
You can't protect a range - you set ranges to either "locked" or "unlocked" and then protect the whole sheet
To begin with, all cells are set to locked, but as the spreadsheet isn't protected this has no affect. In your case (assuming you want to be able to change other cells), you would need to unlock every other cell, lock the range you want to prevent changes in, and then protect the sheet. So
Sub secure()
dim ws as worksheet 'i change this line - typo
For each ws in worksheets
ws.cells.locked=false
ws.Range("C7:P16").locked=true
ws.Protect Password:="30713"
next ws
End Sub
Sub Desecure
dim ws as worksheet
For each ws in worksheets
ws.unprotect "30713"
Next ws
End Sub

Application.Caller / Storing worksheet name as string

Im trying to store the CurrentWorksheet name in order to reference it in a different Sub routine.
The code I currently have is as follows:
Private Sub InsertNewBill_Click()
Dim rng As Range
Set rng = Worksheets(CurrentWorksheet).Range("A30:L30")
rng.Insert Shift:=xlDown
End Sub
Current Worksheet Function:
Function CurrentWorksheet()
CurrentSheet = Application.Caller.Worksheet.Name
End Function
I need to try to reference the "CurrentSheet" variable in the "InsertNewBill" Sub routine.
The function of this is to insert a new line of cells between "A30:L30" on the currently selected worksheet.
Thanks in advance
I didn't plan to write this as answer, but to explain to Batteredburrito how to deal with objects rather than names:
Option Explicit
Private Sub InsertNewBill_Click()
Dim rng As Range
Set rng = currentWorksheet.Range("A31:AC31")
rng.Insert Shift:=xlDown
End Sub
Current Worksheet Function
Function currentWorksheet() As Worksheet
set currentWorksheet = ActiveSheet
End Function
This is doing exactly the same as your version (so you can stick with that), it's just to show how to deal with objects. But there are situations where it is much better to deal with objects that with name - especially if you are dealing with multiple Workbooks (that might have the same sheet names).
And, of course, in the end you could get rid of the function completely by simply writing
...
Set rng = ActiveSheet.Range("A31:AC31")
...
Thank you all for your help and direction.
I have resolved the issue with the following
Insert new cells between a range of cells on button press:
Private Sub InsertNewBill_Click()
Dim rng As Range
Set rng = Worksheets(CurrentWorksheet).Range("A31:AC31")
rng.Insert Shift:=xlDown
End Sub
Current Worksheet Function:
Function CurrentWorksheet()
CurrentWorksheet = ActiveSheet.Name
End Function

Populating ComboBox with dynamic values from another worksheet

---Update---
Thanks for the responses, I have found that DragonSamu's updated answer works perfectly.
---Original Post---
I have been trying to figure out where I am going wrong for the past few hours but I can't spot it. I think it's because the script is trying to draw the value from the active worksheet which is not what I want. Hopefully somebody can put me on the rite track - I think the answer should be relatively obvious but I just can't see it!
Basically, I am trying to populate a Combobox with a dynamic range of values that exist in another worksheet (but in the same workbook). I can get the Combobox to populate when I run the script in the worksheet 'Materials' (which is where the dynamic list is drawn from) but not when I run it in the worksheet 'Products'.
Unfortunately the script is designed to populate Products with Materials so is be run in a UserForm when the 'Products' worksheet is open and the 'Materials' worksheet would therefore be inactive.
I should also note that this script has been adapted from code I found elsewhere on this forum, so if it seems familiar I thank you in advance :)
Private Sub UserForm_Initialize()
Dim rRange As Range
On Error GoTo ErrorHandle
'We set our range = the cell B7 in Materials
Set rRange = Worksheets("Materials").Range("B7")
'Check if the cell is empty
If Len(rRange.Formula) = 0 Then
MsgBox "The list is empty"
GoTo BeforeExit
End If
'Finds the next empty row and expands rRange
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
'The range's address is our rowsource
Mat1_Name_ComBox.RowSource = rRange.Address
Mat2_Name_ComBox.RowSource = rRange.Address
Mat3_Name_ComBox.RowSource = rRange.Address
Mat4_Name_ComBox.RowSource = rRange.Address
Mat5_Name_ComBox.RowSource = rRange.Address
BeforeExit:
Set rRange = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub
Any help is much appreciated.
Cheers,
Simon
From what I can see your code would be giving an error here:
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
Because your trying to set rRange by using Range() without defining the Worksheet first. This will get the Range from the ActiveWorksheet.
change it to the following:
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Worksheets("Materials").Range(rRange, rRange.End(xlDown))
End If
best practice would be the following:
Private Sub UserForm_Initialize()
Dim wb as Workbook
Dim sh as Worksheet
Dim rRange As Range
On Error GoTo ErrorHandle
'Set the Workbook and Worksheet
set wb = Workbooks("products.xlsx")
set sh = wb.Worksheets("Materials")
'We set our range = the cell B7 in Materials
Set rRange = sh.Range("B7")
'Check if the cell is empty
If Len(rRange.Formula) = 0 Then
MsgBox "The list is empty"
GoTo BeforeExit
End If
'Finds the next empty row and expands rRange
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = sh.Range(rRange, rRange.End(xlDown))
End If
By properly defining and setting your Workbook and Worksheet you correctly reference to them and don't get errors.
Update:
the 2nd problem is that rRange.Address only places the Range location inside your .RowSource not the Sheet it needs to look at.
change:
Mat1_Name_ComBox.RowSource = rRange.Address
to:
dim strSheet as String
strSheet = "Materials"
Mat1_Name_ComBox.RowSource = strSheet + "!" + rRange.Address
This way it will include the Sheet name into the .RowSource

Copying range of cells from one workbook to another yields 400 error

Okay, so I am relatively new to Excel VBA. I am trying to do something which seems quite simple to me and there are many, many examples of how to do it which I have read exhaustively but I cannot seem to get past this so...here goes.
I am trying to paste a range of cells from one worksheet to another in Excel Microsoft Office Professional Plus 2010. I think I have reduced the problem to the absolute simplest form possible to illustrate the problem. This is just a snippet. The VictimResults and TempWorksheet variables are set higher up. I didn't include the code because I thought it might confuse the articulation of the problem.
Dim SourceWorksheet As Worksheet
Dim TargetWorksheet As Worksheet
Dim SourceRange As Range
Dim TargetRange As Range
Set SourceWorksheet = VictimResults
Set TargetWorksheet = TempWorksheet
Set SourceRange = Cells(1, 1)
Set TargetRange = Cells(1, 1)
TargetWorksheet.Range(TargetRange) = SourceWorksheet.Range(SourceRange)
I have placed the variables SourceWorksheet, TargetWorksheet, SourceRange, and TargetRange in a watch and set a breakpoint at the last line and they are all valid objects (not null). When I step over the breakpoint I get a dialog box which simply says "400".
Any help is much appreciated.
---edit---
I have created this complete VBA file that replicates the problem. Thought that might help someone answer.
Option Explicit
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range(Cells(1, 1)).Value = GetFirstWorksheetContainsName("Sheet2").Range(Cells(1, 1)).Value
End Sub
Function GetFirstWorksheetContainsName(worksheetNameContains) As Worksheet
Dim m As Long
Dim result As Worksheet
m = 1
Do
If InStr(1, Sheets(m).Name, worksheetNameContains) Then
Set result = Sheets(m)
Exit Do
End If
m = m + 1
Loop Until m > ThisWorkbook.Worksheets.Count
Set GetFirstWorksheetContainsName = result
End Function
Here is something else I tried which yields something a little more verbose.
Option Explicit
Sub Main()
Sheets("Sheet1").Select
Range(Cells(1, 1)).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Cells(1, 1)).Select
ActiveSheet.Paste
End Sub
It gives me a "Method 'Range' of object '_Global' failed" error when executing the first Range(Cells(1, 1)).Select line.
If you are trying to copy and paste why not use .copy and .pastespecial. They may slow down your code a little bit but as long as your aren't copying and pasting thousands of things it should be ok.
I'm not sure where the 400 is coming from, but the exception that is thrown is the same is in your verbose example (1004 - "Method 'Range' of object '_Worksheet' failed", and is thrown for the same reason.
The problem is how you're addressing the Range. Cells(1, 1) is implicitly set to the active worksheet, not whatever range you are passing it to as a parameter. Since you only need one cell, you can just use the .Cells property instead:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Cells(1, 1).Value = _
GetFirstWorksheetContainsName("Sheet2").Cells(1, 1).Value
End Sub
If you need to copy more than one cell, you'll have to either grab a reference to a worksheets instead of inlining the calls to GetFirstWorksheetContainsName if you use dynamic ranges:
Sub Main()
Dim source As Worksheet
Dim data As Range
Set source = GetFirstWorksheetContainsName("Sheet2")
Set data = source.Range("A1:B2")
GetFirstWorksheetContainsName("Sheet1").Range(data.Address).Value = data.Value
End Sub
Or hard code it:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range("A1:B2").Value = _
GetFirstWorksheetContainsName("Sheet2").Range("A1:B2").Value
End Sub

Match Index in VBA error

I am trying to use the Index and Match Worksheet Functions to match an item number from a combo box in a user form (ItemNum.value) to a product list table ("Product Pricing") on a worksheet. Then pull cells that match the same row from that worksheet ("Product Pricing") and copy them to cell ("i4") on an input data worksheet ("Review Lighting Data"). The problem is every time I run the macro it gives me the error "1004 Unable to get the Match Property of the WorksheetFunction class error"
My code is:
Private Sub InputLight_Click()
With Sheets("Review Lighting Data")
.Range("i4").Value = Application.WorksheetFunction.Index(Sheets("Product Pricing").Range("c7:c102"), Application.WorksheetFunction.Match(ItemNum.Value, Sheets("Product Pricing").Range("b7:b102"), 0))
End With
End Sub
I've since tried starting a new workbook to try to simplify things. Here is my complete code so far:
Private Sub inputbutton_Click()
Dim MatchRow As Long
Dim WS0 As Worksheet, WS1 As Worksheet
Dim R0 As Range, R1 As Range
With ThisWorkbook
Set WS0 = .Sheets("Review Lighting Data")
Set WS1 = .Sheets("Product Pricing")
End With
With WS1
Set R0 = WS1.Range("B7:B11")
Set R1 = WS1.Range("C7:C11")
End With
MatchRow = Application.Match(itemnum.Value, R0, 0)
MsgBox MatchRow
End Sub
Private Sub UserForm_Initialize()
With Me.itemnum
.AddItem "1001"
.AddItem "1002"
.AddItem "1003"
.AddItem "1004"
.AddItem "1005"
End With
End Sub
I've entered the item numbers into the combobox (itemnum) EXACTLY with no spaces or anything. I've even tried deleting the " marks around each number but that doesn't work either. I've tried outputting (MatchRow) into a MsgBox to try to catch the error but it breaks before it does.
The problem is that when Match doesn't found value in range, it returns error. You can handle this situation using IsError:
Private Sub InputLight_Click()
Dim matchRes
With Sheets("Review Lighting Data")
matchRes = Application.Match(ItemNum.Value, Sheets("Product Pricing").Range("b7:b102"), 0)
If Not IsError(matchRes) Then
.Range("i4").Value = Application.Index(Sheets("Product Pricing").Range("c7:c102"), matchRes)
End If
End With
End Sub
One good practice is to qualify everything properly. This makes the code easier to read and to debug. Also, you have to use Application.Match and not Application.WorksheetFunction....
Private Sub InputLight_Click()
Dim MatchRow
Dim WS0 As Worksheet, WS1 As Worksheet
Dim R0 As Range, R1 As Range
With ThisWorkbook
Set WS0 = .Sheets("Review Lighting Data")
Set WS1 = .Sheets("Product Pricing")
End With
With WS1
Set R0 = .Range("B7:B102")
Set R1 = .Range("C7:C102")
End With
MatchRow = Application.Match(ItemNum.Value, R0, 0)
If Not IsError(MatchRow) Then
WS0.Range("I4").Value = Application.Index(R1, MatchRow)
End If
End Sub
A very similar issue is found here: Match Not working Excel: Error 1004 Unable to get the Match Property, wherein #simoco and I also dealt with it similarly.
Okay after trying a bunch of different ways to get match index working within the userform I decided to 'cheat' a little and just used the regular match index function in the cells. Thank you all so much for your help!