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
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
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
I'm trying to compare the value of one worksheet ("UserProf") column to a value in another worksheet ("DeptClasses") column. If those values are the same, update a separate cell in the first worksheet with a value from another column from the second worksheet. This will also need to loop through the values in the first worksheet looking for a match.
In essence, if the value in A1 in sheet 1 equals the value in sheet 2's cell D1, or D2, or D3, etc., set the value in cell A2 on sheet 1 to the value in sheet 2's matching row next column (i.e. if D1 in sheet 2 matches sheet 1 A1, set A2 to the value currently in sheet 2's E2 cell, etc.).
Each sheet's column has unique values (no duplicates), and is a number but stored as a text value. I tried changing the format of the cells to Number, with no change in the results. The range of columns in each sheet is fixed (hence setting the "To lastXxx" as a fixed integer and not using End(xlUp).Row to set the value. I've used this approach for other spreadsheets/cross-sheet comparison and it works as I expect.
When troubleshooting, I did add more variables to display in the Locals window in VBA and 'stepped into' the script - that is, see the values that were being evaluated, etc.; from what I can tell the "If" statement never evaluates to "True" even when I can see in the Locals that the cell values being compared do match.
There may be a more efficient way to set up the range, etc., but this was a way that worked for me in the past, so was trying to keep in that format - mostly because I understand it.
Sub Profiles()
Dim lastDepClass As Integer
Dim lastClass As Integer
Dim DepClass As Integer
Dim Class As Integer
lastDepClass = 137
lastClass = 106
For Class = 3 To lastClass
For DepClass = 2 To lastDepClass
If Sheets("UserProf").Cells(Class, 1).Value = Sheets("DeptClasses").Cells(DepClass, 5).Value Then
Sheets("DeptClasses").Cells(DepClass, 6) = Sheets("UserProf").Cells(DepClass, 5).Value
End If
Next DepClass
Next Class
End Sub
Sub Profiles()
Dim ws1 As Worksheet, ws2 As Worksheet 'Define worksheet variables
Dim x As Long, y As Long 'Define last row variables
'Assign your variables
Set ws1 = ThisWorkbook.Sheets("UserProf")
Set ws2 = ThisWorkbook.Sheets("DeptClasses")
For x = 3 To 106 'Just use the last row numbers, unless the lastrow is dynamic
For y = 2 To 137 'for each x row loop in ws1 loop through all y rows
'in ws2 until a match is found
If ws1.Cells(x, 1).Value = ws2.Cells(y, 5).Value Then
ws1.Cells(x, 6).Value = ws2.Cells(y, 5).Value
End If
Next y
Next x
End Sub
What I have been doing previously is manually selecting and then copy/paste raw data from a report into a sheet titled "ImportDump". From here I use VBA to select and copy the 11 ranges I am interested in across to specific locations in Sheet1 and Sheet2. I would explicitly state the ranges that the data occupy in the ImportDump sheet and copy them across. This worked but is no longer simple to do.
Instead, I plan to search for each table heading in Column A in the ImportDump sheet using the Find method, and then use the result of Find, plus an offset, as the starting position of a dynamic range. So for example, the string "Capital Premier" is found in A30, but the range I need starts in B33. I then need all rows down to the next blank cell in Column B, and all columns across to the next blank column (data always finishes in Column J). And then repeat for all further 11 heading strings. The headings will all appear in Column A, all the tables will have the same offset from the search string result (3,1), and the same number of columns (9), but not necessarily the same number of rows.
I think I know how to do the search IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart), and I'm pretty sure I can use .End(xldown) to select down to the next blank row, but I'm not sure how to combine all that with an offset to express the starting location of my dynamic range. Could someone please help me to solve this?
Edit: I've found my ideal solution (unless someone comes up with something even better)
This code combines a look at a table on one sheet ("Instructions") for a user-defined string, a search for the string in a separate sheet ("ImportDump" - a raw data dump), once the string is found it jumps to an offset cell location (3,1), finds the last row and last column before the next blank, selects the range outlined by the offset location, lastrow and lastcol, copies the range to a location (Sheet, then Cell) defined in the initial search table that corresponds to the search string. It then loops through all the rest of the user-defined strings until the last row of the table in the "Instructions" sheet, finding the ranges and pasting them into the corresponding predetermined locations. Thanks for everyone's input!
Sub ImportLeagueTables()
Dim r As Range
Dim i As Integer
Dim IDump As Worksheet
Dim Instruct As Worksheet
Dim what1, where1, where2 As String
Dim TeamRng, TableRng, f, g As Range
Dim LastRowTeam As Long, Lastrow, Lastcol As Long
Set Instruct = Sheets("Instructions")
Set IDump = Sheets("ImportDump")
LastRowTeam = Instruct.Range("M4").End(xlDown).Row
Set TeamRng = Instruct.Range("M4:O" & LastRowTeam)
i = 1
For Each r In TeamRng.Rows 'rows to loop through
what1 = TeamRng.Range("A" & i) 'the string to find
where1 = TeamRng.Range("B" & i)
where2 = TeamRng.Range("C" & i)
Set f = IDump.Columns(1).Find(what1, LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Lastrow = g.Range("A1").End(xlDown).Row
Lastcol = g.SpecialCells(xlCellTypeLastCell).Column
Set TableRng = IDump.Range(g, IDump.Cells(Lastrow, Lastcol))
TableRng.Copy
Sheets(where1).Range(where2).PasteSpecial xlValues
i = i + 1
Next r
End Sub
Original, less robust solution: Ok, I've come up with a workable solution by explicitly defining the range with reference to the first cell i.e. Set g = f.Offset(3, 1) and Set CapPremRng = g.Range("A1:I10"), although that's not as elegant as I would like. Would prefer to use g to select all cells down and across until the next blank row/column.
Full code:
Sub DoMyJob()
Dim IDump As Worksheet
Dim f As Range
Dim g As Range
Dim CapPremRng As Range
Set IDump = Sheets("ImportDump")
Set f = IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Set CapPremRng = g.Range("A1:I10")
CapPremRng.Copy
Sheets("Sheet3").Range("A1" & LastRow).PasteSpecial xlValues
End Sub
I want to be able to dynamically select a range of cells (the heading row), where the row is 1 but the columns with be for 1 to last column, where "A" is the first Column and where "M" is the last column. I know how to find the last column, but I don't know how to modified the below range to input the first and last column as "A" and "M".
Range("A1:M1").Select
If you want to select a variable range containing all headers cells:
Dim sht as WorkSheet
Set sht = This Workbook.Sheets("Data")
'Range(Cells(1,1),Cells(1,Columns.Count).End(xlToLeft)).Select '<<< NOT ROBUST
sht.Range(sht.Cells(1,1),sht.Cells(1,Columns.Count).End(xlToLeft)).Select
...as long as there's no other content on that row.
EDIT: updated to stress that when using Range(Cells(...), Cells(...)) it's good practice to qualify both Range and Cells with a worksheet reference.
sub selectVar ()
dim x,y as integer
let srange = "A" & x & ":" & "m" & y
range(srange).select
end sub
I think this is the simplest way.
So it depends on how you want to pick the incrementer, but this should work:
Range("A1:" & Cells(1, i).Address).Select
Where i is the variable that represents the column you want to select (1=A, 2=B, etc.). Do you want to do this by column letter instead? We can adjust if so :)
If you want the beginning to be dynamic as well, you can try this:
Sub SelectCols()
Dim Col1 As Integer
Dim Col2 As Integer
Col1 = 2
Col2 = 4
Range(Cells(1, Col1), Cells(1, Col2)).Select
End Sub
I like to used this method the most, it will auto select the first column to the last column being used. However, if the last cell in the first row or the last cell in the first column are empty, this code will not calculate properly. Check the link for other methods to dynamically select cell range.
Sub DynamicRange()
'Best used when first column has value on last row and first row has a value in the last column
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("A1")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub