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
Related
After failing to figure out how to do that for a while, I'll try my luck here:
I'm essentially trying to compare two situations using VBA.
A similar (and a lot simpler) example:
F2, for example, calculate 152+D2, while F3 calculates 185+D3.
I wish to run a macro that would check the effect of one person getting a different amount of points. For example, if A2 = Max the macro should assign the value of A3 (18) to D3. If A2 = Lewis, 18 would become the new value of D2.
Tried using vlookup and match+index in order to find the cell that I want to change. When using vlookup, the code looked similar to this:
First I copied F2:F4 to I2:I4, so the results would be comparable. Then tried to replace the value of D2:D4 according to A2&A3:
name = Range("A2").value
newvalue = Range("A3").value
Find = Application.VLookup(name, Range("C2:D4"), 2, False)
Find.value = newvalue
Perhaps I should be looking for the cell itself, and not the value, and then it would work (maybe using offset, or offset+match? couldn't make it work)?
Would appreciate any help!
Not really sure what the intention is but this seems like a fun challenge.
So logic is this. We look for the name in column C. If we get a match we will get a row back as an answer, then we replace the value from "A3" and add it to the row we got but to the column D.
Maybe something like this :D?
Option Explicit
Sub something_test()
Dim lookup_val As String
Dim lrow As Long
Dim lookup_rng As Range
Dim match_row As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'Name the worksheet
lrow = ws.Cells(Rows.Count, "C").End(xlUp).Row 'Find last row in Sheet1
lookup_val = ws.Cells(2, "A").Value 'Set the lookup value
Set lookup_rng = ws.Range("C2:C" & lrow) 'set the lookup range
match_row = Application.Match(lookup_val, lookup_rng, 0) + 1 'Find the name in column C. Add +1 since the range starts at row 2. We will get the row number back
ws.Cells(match_row, "D").Value = ws.Cells(3, "A").Value 'Take the value from "A3" and replace the existing value at the row we found, but for column D
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 am wondering how I can generate a list of cells in Excel file that contain a given substring using VBA. This should be able to find the cells regardless of the upper/lower case.
An example is:
Given the user-defined inputs (apple and berry), it sholud return the second picture.
How do I do this in VBA?
You say generate a list... So I assume you won't override your old data.
This code checks for the two values in worksheet "Sheet1". Then compares the two values you define against the cell value in your data (your data is assumed to be in Column A, from row 1 and downwards). If either of defined values exist in the cell (apple or berry, regardless of small/big letters), it's considered a match. If match is found it will copy the value to the first empty row in Column B.
VBA Code:
Sub SearchAndExtract()
Dim lrow As Long
Dim lrowNewList As Long
Dim i As Long
Dim lookupValue As String
Dim lookupValue2 As String
Dim currentValue As String
Dim MySheet As Worksheet
Set MySheet = ActiveWorkbook.Worksheets("Sheet1")
lookupValue = "*apple*" 'First name you want to search for. Use * for wildcard
lookupValue2 = "*berry*" 'Second name you want to search for. Use * for wildcard
lrow = MySheet.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row in your data column
lrowNewList = MySheet.Cells(Rows.Count, "B").End(xlUp).Row 'Find last row in the column you want to paste to
For i = 1 To lrow 'From Row 1 to last row in the column where you want to check your data
currentValue = MySheet.Cells(i, "A").Value 'Define the string value you have in your current cell
If LCase$(currentValue) Like LCase$(lookupValue) Or _
LCase$(currentValue) Like LCase$(lookupValue2) Then 'LCase for case sensitivity, it check the current cell against the two lookup values. If either of those are find, then
MySheet.Cells(lrowNewList, "B") = MySheet.Cells(i, "A") 'Copy from current cell in column a to last blank cell in column B
lrowNewList = lrowNewList + 1
End If
Next i
End Sub
I have been looking around the site for a while for an answer to this question but no luck just yet. I have this code where I loop through a row of numbers and depending on what number is in the cell at the time, determines what I copy and paste to the sheet. I am using Columns for this because it is the only way I can make my code dynamic. It works but when I paste I would like to paste in cells lower than where it's pasting right now. I was wondering if Columns had a way of specifying what column and where to paste my data.
Code:
Dim sh As Worksheet
Dim rw As Range
Dim row As Range
Dim cell As Range
Dim RowCount As Integer
Set rw = Range("A5:CG5")
Set sh = ActiveSheet
For Each row In rw.Rows
For Each cell In row.Cells
Select Case cell.Value
Case "2"
ThisWorkbook.Worksheets("Sheet1").Range("E27:E51").Copy Destination:=Sheets("Sheet2").Columns(4)
End Select
Next cell
Next row
Your problem can be solved as Jeeped said, use Destination:=Sheets("Sheet2").Cells(27, 5) or Destination:=Worksheets(2).Range("E27")
Since you want to learn a little bit more, i made an example explanation:
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-column-property-excel
On the link it is explained that .Column:
Column A returns 1, column B returns 2, and so on.
And the same is with the .Rows
Use .Cells https://msdn.microsoft.com/pt-br/library/office/ff194567.aspx So you can use the .Cells(Rows,Columns) or .Cells(Index from a Range) or the entire Object:
With Worksheets("Sheet1").Cells.Font
.Name = "Arial"
.Size = 8
End With
So an example if you want to turn your spreadsheet dynamical: to copy from range $E$27 to last row with something written from column $E on Sheet1 To
the last column with nothing written on row 1 on Sheet2.
Sub test()
'Declare variables here
Dim sht1, sht2 As Worksheet
'sht1 has the data and sht2 is the output Worksheet, you can change the names
last_row = Worksheets(1).Range("E65536").End(xlUp).Row
last_column = Worksheets(2).Cells(1, sht1.Columns.Count).End(xlToLeft).Column
'Data add
For i = 27 To last_row
'Start from Row 27
Worksheets(2).Cells(i - 26, last_column + 1) = Worksheets(1).Cells(i, 5)
Next i
MsgBox "Data Updated"
End Sub
And an example of a basic dynamical workbook with i=i+1 and For loops split a single row of data into multiple unique rows into a new sheet to include headers as values and cell contents as values
good people, I have a table full of unique id's (as mentioned below) but there are missing values for few id's.
I want a formula/code to fill in the blanks based on the values above and below of any cell.
For example: here there are two empty rows between two unique id~(620006845180).
can anyone help me with filling up these spaces with the same value as above and below. :( I am stuck.
620006845180
xxxxxxxxxxxx
xxxxxxxxxxxx
620006845180
620006845180
ok, sure. this assumes the id's are in column A
Sub FillBlankCells()
Dim lastRow As Long: lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim IDRange As Range: Set IDRange = Range("A1:A" & lastRow)
Dim rng As Range
For Each rng In IDRange
If rng.Value = "" Then
If rng.End(xlUp).Value = rng.End(xlDown).Value Then _
rng.Value = rng.End(xlUp).Value
End If
Next rng
End Sub
You cannot do this in a same column because of circular reference. But you can use another column to do it.
I assume that you have these numbers in column A and from row 2 and you insert an empty column in B and you enter the following formula in B2. Then copy the rest of the rows of the column B from the cell B2. Then Hide your column A, you will get what you wanted in column B.
=IF(A2<>"",A2,IFERROR(IF(MATCH(B1,A3:A100,0)>0,B1,""),""))
If you feel there could more than 100 empty rows. Then you may need to replace the 100 found in the formula to what is the maximum number of rows that you expect to be empty.