Excel VBA - Making a Named Range based on a found cell - vba

I am trying to figure out how to make a named range, based on a cell found using:
For Each Cell In ISBN_Range
If Cell.Value = ISBN Then
ISBN_Valid = True
ISBN_Found = Range("A" & Cell.RowIndex & ":E" & Cell.RowIndex)
ISBN_Found.Interior.ColorIndex = 6
Exit For
End If
Next Cell
This is not working, and I am not sure why, I haven't been able to find the answer elsewhere, sorry if this is really simple! I basically just want to make the row of data that the found cell exists in a named range. ISBN_Found is declared as a range much earlier in my code, so that is not the issue.

I figured out the answer with some help from the guys in the comments, final code looks like this:
For Each Cell In ISBN_Range
If Cell.Value = ISBN Then
ISBN_Valid = True
Set ISBN_Found = Range("A" & Cell.Row & ":E" & Cell.Row)
ISBN_Found.Interior.ColorIndex = 6
Exit For
End If
Next Cell
Just needed to delete "Index" from "Cell.RowIndex"

Related

Excel VBA Changing Combobox list from static range to dynamic

This should be pretty simple, but I am struggling.
Right now, this code works:
cboCategoryEdit1.List = Sheets(2).Range("A2:A40").Value
I am trying to "clean up" my project by changing how the combobox is populated. I'd like it to be a combobox with a range that only takes populated cells. Meaning I need to use the last row function. I changed the code to this and I just get an error of "Method or Data Member Not Found". Here is my problem code:
Dim i As Range
With Sheets("xRef-Categories")
Set i = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Me.cboCategoryEdit1.ListFillRange = i.Address
Thanks for any help on this one.
btw: Sheet2 is "xref-Categories"
You simply need this...
With Sheets("xRef-Categories")
Me.cboCategoryEdit1.List = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With
You can simplify it like this:
With Sheets("xRef-Categories")
Me.cboCategoryEdit1.List = .Range("A2" , .Range("A" & .Rows.Count).End(xlUp)).Value
End With

If condition is met copy cell.values in one row

I'm sorry but I asked this question already yesterday, but it seems like I wasn't clear enough with my wishes, so I try it again this time.
My code Looks like this right now:
If OptionButton11.Value = True Then
Set Rng = Sheets("Table").Range(TextBox3.Value & TextBox1.Value + 1 & ":" & TextBox3.Value & lastrow)
Set kst = Sheets("Table").Range(TextBox2.Value & TextBox1.Value + 1 & ":" & TextBox2.Value & lastrow)
For Each Cell In Rng
If Cell.Value = TextBox10.Value Then
Cell.copy Cell.Offset(, 1)
Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = kst.Value
End If
Next Cell
End If
In this scenario, the user has the opportunity to use textboxes to define where his values are in the worksheet and what the macro has to look for.
Textbox1.Value defines where the headings in the worksheet are.
`
Textbox2.Value defines where the value can be found
Textbox3.Value is the criteria after the value is filtered
And
Textbox.Value 4 is the required criteria.
I would like to achieve with this code; that whenever Textbox4.Value is found in the range of Textbox3.Value, TextBox2.Value and Textbox3.Value are copied into the first free columns in the worksheet.
My Problem right now is, that
Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = kst.Value
do not copy the values in the first empty column, but add them horizontally to each freely available row in a column.
I already tried it with xlDown instead of xlToLeft but then a runtimerror (1004) appears.
Has anyone a suggestion how to fix this?
Thank you.

LOOP: Copy Cells Value (in a list) from one Sheet to Another

The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub

Excel VBA range select

I have a macro in which I need to select the range R2:last row in sheet. However the last row in my sheet might be blank in column R. At the moment I am using this
Dim t As Range
Set t = Range("R2", Range("R1000").End(xlUp))
For Each Cell In t
If IsEmpty(Cell) Then
Cell.Activate
ActiveCell.Value = "To Be Picked Up"
End If
Next
However if the last row has a blank in column R then it gets ignored. I am hoping to pull the range using column A, as the last row of data always has column A. So something like,
Dim t As Range
Set t = Range("R2", Range("A1000").End(xlUp).ActiveCell.Offset(0, 17))
For Each Cell In t
If IsEmpty(Cell) Then
Cell.Activate
ActiveCell.Value = "To Be Picked Up"
End If
Next
It seems so simple but I'm sure im missing something stupid. Any help or alternative methods would be helpful thank you.
This should do the trick in one line:
Sub SO()
Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Value = "To Be Picked Up"
End Sub
But in answer to your question specifically
Set t = Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row)
The Range() method will accept a string as an argument to obtain a range.So we can build this string any way we want:
"A1000" '// A1000
"A" & 1000 '// A1000
"A" & "10" & "00" '// A1000
"A" & CStr(1001 - 1) '// A1000
"A" & Rows.Count will return A65536 or A1048576 depending on the type of worksheet.
Range("A1048576").End(xlUp) as you know, will retrieve the last cell in that area, or the first cell in the next area on the direction specified.
Range("A1048576").End(xlUp).Row will return the row number of that cell (let's say it's A1000 for argument's sake) so the return value is 1000.
"R2:R" & Range("A" & Rows.Count).End(xlUp).Row therefore makes the string R2:R1000.
So finally, Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row) is the same as Range("R2:R1000")

1004: Application defined error when trying to examine cell contents

I am trying to loop through the rows in my sheet, adding cells B-F of the current row to a range to be copied to another sheet. The cells in the row (B-F) should only be added to the range if the value in column G is "Active" and if the value in column C has a value (not empty/nothing/null/!#VALUE...)
I've tried several ways around it, but I keep getting 1004: App/Object defined error off the first If statement
The msgbox shows me the range is valid, I've tried qualifying to the tiniest detail and also using Cells() instead of .range to no avail.
MsgBox (ActiveWorkbook.Worksheets("Staging").range("G" & Cells(rows.Count, 5).End(xlUp).Row).Value)
For i = Cells(rows.Count, 5).End(xlUp).Row To i = 1 Step -1
If ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value = "Active" Then
If Not IsError(ActiveWorkbook.Worksheets("Staging").range("C" & i)) Then
Set selectRange = range("B" & i & ":F" & i)
Set copyRange = Union2(copyRange, selectRange)
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next
Am I just missing something simple here? I've been banging my head over this for hours now.
...and for you eagle eyes out there, Union2 isn't a typo, just a user defined function to avoid not being able to join ranges set to "Nothing"
Try the following:
Change the second line to
For i = Cells(rows.Count, 5).End(xlUp).Row To 1 Step -1
Change the third line to
If ActiveWorkbook.Worksheets("Staging").Range("G" & i).Value = "Active" Then
To start change:
If ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value = "Active" Then
To
If ActiveWorkbook.Worksheets("Staging").Range("G" & i).Value = "Active" Then
Or
If ActiveWorkbook.Worksheets("Staging").Cells(i , 7).Value = "Active" Then
You also need to fully qualify all your ranges as alot of your ranges are pointing to the active sheet and NOT "staging" Unless it is the active sheet, but just to be sure you should use the following code:
With ActiveWorkbook.Worksheets("Staging")
MsgBox (.Range("G" & .Cells(.Rows.Count, 5).End(xlUp).Row).Value)
For i = .Cells(.Rows.Count, 5).End(xlUp).Row To 1 Step -1
If .Range("G" & i).Value = "Active" Then
If Not IsError(.Range("C" & i)) Then
Set SelectRange = .Range("B" & i & ":F" & i)
Set copyRange = Union(copyRange, SelectRange)
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next
End With
Also You are using copyRange in this scope without it being declared, I am assuming you are assigning it to a range earlier in your code but if not please make sure to do that.
This is wrong:
ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value
You can use these:
ActiveWorkbook.Worksheets("Staging").Cells(i, 6)
ActiveWorkbook.Worksheets("Staging").range(cells(i, 6), cells(i, 6)).value
ActiveWorkbook.Worksheets("Staging").range("G" + strings.trim(str(i))).value
I was getting the below Error:
Go to Home -> Select the cell for which you are getting Error-> Use clear all funtion to clear the method.
I executed the script again and it started working fine.