this is a follow up to my post at: Excel VBA: Switch Case to read values from a column
I currently have one working switch statement that looks for a case e.g (493) from Column I, and if it finds 493 it returns "Robotics" in column G.
Now I need to create a second switch statement that looks for a case e.g (EPA0012) from column AN, and if it finds EPA0012 it will display "Accounting" in column AO. The issue I am encountering is that when I run the same code that I used for the first switch statement, instead of it populating the adjacent column with "Accounting", it instead populates every single cell in the column except for the column adjacent to EPA0012 (where it should be populating).
The issue is because of "EPA" as when I removed this and just use 0012 it worked perfectly so I am assuming I need to adjust a variable or something.
The code is as follows:
Public Sub Switch_Statement_EPA()
Dim wsSort As Worksheet
Set wsSort = Workbooks("Test.xlsm").Worksheets(2)
With wsSort
Dim lastRow As Long
lastRow = .Range("AN" & .Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = .Range("AN2:AN" & lastRow)
Dim cell As Range
For Each cell In rng '<--- the loop
Select Case cell.Value
Case EPA0012
cell.Offset(, 1).Value = "Accounting"
End Select
Next
End With
MsgBox ("Done")
End Sub
Related
I would like to apply a formula to a given range.
However, the number of columns are not fixed and will vary.
Screenshots to visualise what I'm doing.
Screenshot 1: I would like for the code to auto select from column C onwards, and apply the formula in the next image. The number of columns will vary as more students attempt the quiz.
Screenshot 2: This is the formula I wish to apply to the selected range. After that, I would be able to loop through the list of teachers from B31 and below one by one, copy the range of answers for each teacher's students and paste them onto Sheets 3-6 which contain the first set of results I mentioned earlier.
Sub obtainsecond()
Sheets("Question_answers").Select
Range("C31").Select
ActiveCell.Formula2R1C1 = _
"=FILTER(R[-29]C:R[-4]C[3],ISNUMBER(SEARCH(R[-1]C,R[-30]C:R[-30]C[3])))"
End Sub
One approach to solve the problem.
This approach assumes that the last column in row 1 is the last column with a student answer.
Logic:
I check the last column and get the cell reference (i.e. $H1). Then i extract only the column letter. I take the column letter and put it in the formula you want to extend.
Code:
Option Explicit
Sub obtainsecond()
Dim QA_ws As Worksheet 'Declare the worksheet as a variable
Set QA_ws = ActiveWorkbook.Worksheets("Question_answers") 'Decide which worksheet to declare
Dim lCol As Long
Dim LastColumnLetter As String
Dim lColRange As Range
QA_ws.Activate 'Go to the worksheet
lCol = QA_ws.Cells(1, Columns.Count).End(xlToLeft).Column 'Find the last column in the worksheet by checking in row 1
Set lColRange = QA_ws.Cells(1, lCol) 'Set last column to get cell reference, i.e. $H1
'MsgBox lColRange.Address(RowAbsolute:=False) ' $H1
'https://www.exceltip.com/tips/how-to-convert-excel-column-number-to-letter.html (Formula to extract letter: =SUBSTITUTE(ADDRESS(1,B2,4),1,””))
LastColumnLetter = WorksheetFunction.Substitute(lColRange.Address(RowAbsolute:=False), "1", "") 'Get column letter
LastColumnLetter = Replace(LastColumnLetter, "$", "") 'Remove prefix
QA_ws.Range("C31").Formula2 = "=FILTER(C2:" & LastColumnLetter & "27,ISNUMBER(SEARCH(C30,C1:" & LastColumnLetter & "1)))" 'Use relative formula to print in cell (original formula: =FILTER(C2:F27,ISNUMBER(SEARCH(C30,C1:F1))))
End Sub
Want to select the rows, which has values greater than or equal to "2.5" in column "H"
then want to select adjacent rows to that row. so that I can copy them to a new sheet
For example (Plz refer Attached Image)
I want to select rows 409 410 411 because row 410 has a value equal to "2.5" in
column "H"
Please suggest a VBA Code, My trial code looks like this
Sub Selectrows()
Dim lastrow As Long
Dim i As Range
lastrow = Range("E" & Rows.Count).End(xlUp).row
For Each i In Range("H4:H" & lastrow)
If i.Value >= 2.5 Then
i.Select
ActiveCell.Rows("1:1").EntireRow.Select
End If
Next I
End Sub
PS : Sorry for my English, I'm new to English and VBA
Problem with the answered code
Here's a possible enhancement of your code (explanation in comments)
Option Explicit
Sub Selectrows()
Dim lastrow As Long
Dim cel As Range
Dim destSht As Worksheet
Set destSht = Worksheets("myDestinationSheetName") '<-- change "myDestinationSheetName" to your actual destination sheet name
With Worksheets("mySourceSheetName") ' reference source sheet - change "mySourceSheetName" to your actual source sheet name
lastrow = .Range("E" & .Rows.Count).End(xlUp).Row ' get referenced sheet column E last not empty cell row index
For Each cel In .Range("H4:H" & lastrow).SpecialCells(xlCellTypeFormulas) ' loop through referenced sheet column H cells cointaining formulas from row 4 down to column E las not empty one
If cel.Value >= 2.5 Then cel.Offset(-1, 0).Resize(3, 1).EntireRow.Copy Destination:=destSht.Cells(destSht.Rows.Count, 1).End(xlUp).Offset(1)
Next
End With
End Sub
as you see I suggest
to use With .. End With block to reference a specific object (Worksheets("mySourceSheetName") in this case) and inside it use dots (.) before each of its child member (like Range, Cells, …) to be make sure they do belong to referenced object
to use SpecialCells() method of Range object to filter only cells with "constant" (i.e. not deriving from formulas) content
to use .Offset() property to offset the the range object it's being called on (cel in this case) one row up and zero column aside
to use .Resize() property to widen the range object it's being called on (cel.Offset(-1,0) in this case) to three rows in height and one column in width
I have the example where I want to write a VBA statement which will select all data in a single column, there are no blanks in the column data. The column position will never change e.g. column A, and the data starts in row 3. However the total number of rows in the column will change regularly.
I want the system to dynamically select all the cells in column and then I can run a method against these selected pieces of data.
As an example of performing an action on your range without selecting it:
Public Sub Test()
Dim rColA As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rColA = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp))
MsgBox "Column A range is " & rColA.Address 'Delete if you want.
rColA.Interior.Color = RGB(255, 0, 0) 'Turn the back colour red.
rColA.Cells(2, 1).Insert Shift:=xlDown 'Insert a blank row at second cell in range
'So will insert at A4.
'If the first cell in your range is a number then double it.
If IsNumeric(rColA.Cells(1, 1)) Then
rColA.Cells(1, 1) = rColA.Cells(1, 1) * 2
End If
End With
End Sub
Try
Dim LastRow as Long, sht as worksheet
Set sht = ThisWorkbook.Worksheets("My Sheet Name")
LastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
sht.Range("A3:A" & LastRow).Select
Like Darren Bartrup-Cook says, you may not need to select the data, you can almost always perform actions directly which is much faster.
If your column is "isolated" meaning no other nonblank cells touch your data you can use:
Range("firstCellInYourColumn").CurrentRegion.Select
(this works the same way as Ctrl+* from keyboard)
otherwise use:
Range(Range("firstCellInYourColumn"), Range("firstCellInYourColumn").End(xlDown)).Select
both will work if there are really no blanks within your data.
You should also prepend all Range with worksheet expression, I omitted this.
To start with I'm not really a wise man. So I was trying to add up two values and display them in a third (that's easy) but I also wanted it to repeat an infinite amount of times (namely that it does the same for every row, let's say I place the result in I5, I want also, on every I under it (I6, I7, I8, etc...)
Should it be:
Private Sub Worksheet_Change()
if IsNumeric(Range("B1").sort) And IsNumeric(Range("B2").sort) then
Dim value1 As Single
Dim value2 As Single
range(I5).sort = value+1 + value2
End Sub
Or as I think I'm horribly mistaken?
You're using the .Sort property of Range where you should be using .Value.
There's a couple of ways to achieve what you're looking to do. First option is to iterate through the range and add the relevant value to each cell like so:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet_Name")
'Set the range below:
Set rng = .Range("I1:I10")
'Loop through range and add cells together
For Each cell In rng
cell.Value = cell.Offset(0, 2) + cell.Offset(0, 1)
Next cell
End Sub
Another way to do it if the values to be added is ordered in for example column A and B would be:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet1")
'Add the first formula to the sheet
.Range("C1").Value = "=SUM(A1+B1)"
'Change the range below to the range to be filled
.Range("C1").AutoFill Destination:=.Range("C1:C10")
End With
End Sub
I'm a complete beginner to Excel VBA.
The following is code I've written that should iterate through a column in a sheet, filling values by referring to the column value to it's left and referring to another sheet in the same workbook to find what the correct corresponding value should be.
I've used a While loop so i can apply this VLOOKUP macro to each cell in the column ( only the lookup value, changes, which should be a variable denoting the column to the left) :
Dim result As String
Dim sheet As Worksheet
Dim rownum As Integer
Dim iterator As Integer
Dim lookup_value As String
Dim vlookupString1 As String
Set sheet = ActiveWorkbook.Sheets("datasheet")
rownum = sheet.Range("A1").End(xlDown).Row
Set iterator = 3
While iterator < rownum
lookup = "M" & iterator
vlookup1String = "=VLOOKUP(" & lookup & ",'GICS Sub-industry codes'!$A$2:$B$155,2,FALSE)"
With ActiveSheet.Cells
Range("N" & iterator).Select
Selection.Value = vlookup1String
End With
iterator = iterator + 1
End While
I'm getting an error # end while saying "expected if or select or sub..."
1) Have i made a syntax error?
2) Is my approach correct. I have observed this string approach to designing VLOOKUPS in vba only in one other place. It seemed best suited.
Fixing your code
You should use Wend not End While for your loop.
Cleaner Alternative
But you can fill an entire range in a single shot as below
It is better to "loop up" a range from the bottom using End(xlup) than to look down with End(xlDown) (which relies on no spaces)
You almost never need to use Select in VBA
Further explanation
rng1 sets a working range from the last used cell in column A in sheet datasheet to A3
rng1.Offset(0, Range("N1").Column - 1) says offset rng1 (which is column A) by 13 columns to use column N (ie OFFSET A by 14-1) for the formula insertion
I used the macro recorder to get the code you needed in column N for this part "=VLOOKUP(RC[-1],'GICS Sub-industry codes'!R2C1:R155C2,2,FALSE)".
IN R1C1 speak, RC[-1] means refer to the cell in the same row, but one column to the left. So in N3, the formula will start as =VLOOKUP(M4..), So in N30, the formula will start as `=VLOOKUP(M30..) etc
Suggested code
Sub QuickFill()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets("datasheet")
Set rng1 = ws.Range(ws.[a3], ws.Cells(Rows.Count, "A").End(xlUp))
rng1.Offset(0, Range("N1").Column - 1).FormulaR1C1 = "=VLOOKUP(RC[-1],'GICS Sub-industry codes'!R2C1:R155C2,2,FALSE)"
End Sub