I am very new to VBA and only understand basic principles so this might not be possible with the code I have used. I have some code for finding a value in Sheet1 using a range from Sheet2, which pastes entiore row to Sheet3. How could I modify it so that it will still paste the row based on a like value and not an exact match, so would paste the row if "Company Ltd" was in Sheet1 and just Company was in the range. I have tried wildcard statements but can't get them to work with a range. Can anyone point me in the right direction?
Option Compare Text
Sub Find_Values()
Dim c1 As Range, rng1
Dim c2 As Range, rng2
Dim lastrow As Long
Set rng1 = Range("sheet1!a1:a10")
Set rng2 = Range("sheet2!a1:a10")
For Each c2 In rng2
For Each c1 In rng1
If c1 = c2 Then
c1.EntireRow.Copy
Sheets("sheet3").Activate
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lastrow + 1).Select
ActiveSheet.Paste
End If
Next c1
Next c2
End Sub
Thank you
What Sam was trying to say is modify this line:
If c1 = c2 Then
You can use:
If InStr(c1,c2) > 0 Then '...
You can also use
If InStr(c1,c2) > 0 or InStr(c2,c1) > 0 or UCase(c2) = UCase(c1) Then '...
Etc.
There are a lot of different comparisons you can add to this line of code.
Making both values uppercase is a good way to do comparisons if you are just interested in the value.
You can also change your code (quite significantly) to use the find keyword which allows you to use wildcards and search using xlWhole and xlPart
It really depends on what the differences are and how much code you want to change.
You might also be interested in using the Like Operator, although if you're simply comparing values, it is probably not what you need.
To find if a string exists within another string, use the InStr function. For example,
Dim stringPosition As Integer
stringPosition = InStr("Company Ltd", "Company")
If stringPosition > 0 Then
' we found a match
End If
Related
I have the problem of needing to exclude a column in the middle of my excel worksheet. Is there a way of creating a range that excludes a column not on the edges of the data. The range is dynamic ranging from A1:AA#. The column "F" needs to be excluded from this range. This range needs to be stored for use in a pivotTable.
Range("A1:E4,G1:J4").Select
This is how the excel macro recorder creates a range with a gap, but I cannot find a way to modify this so the last cell is dynamic.
Thanks.
Just as you should avoid using the .Select Method, you should also avoid using the .UsedRange when possible (See here).
You can try something like this. It is not as clean, but may prove to be less bug prone.
Dim LRow As Long
LRow = Range("A" & Rows.Count).End(xlUp).Row
Dim MyRange1 As Range, MyRange2 As Range, BigRange As Range
Set MyRange1 = Range("A1:E" & LRow)
Set MyRange2 = Range("G1:J" & LRow)
Set BigRange = Application.Union(MyRange1, MyRange2)
BigRange.Select
You can then refer to your BigRange directly moving forward.
If you have only one set of data in your sheet, you could try something like that :
Intersect(ActiveSheet.UsedRange, Range("A:E,G:AA")).Select
This will select everything that contains data up to column AA on the sheet except for column F.
Whenever possible , you should avoid using .select .activate but you only provide one line of your code so I can't help you much on that part except redirect you to this.
you could use
Dim rng As Range
Set rng = Intersect(Range("A:E,G:AA"), Rows(1).Resize(Cells(Rows.Count, 1).End(xlUp).Row))
where the column index in Cells(Rows.Count, 1) lets you choose what column size your range after
I populated an excel sheet with the locations of blank cells in my sheet using suggestions from this post. So I have a Column A filled with locations in the following format
$X$1 or $X2:$X$4.
What I am trying to do is use those row numbers from the column explain above to populate a separate column. I want to use the row numbers as a reference in what to populate for the column. So a Column B looking something like
=$B$1 or =$B$2:$B$4 (took 1 and 2-4 and used it as row number for reference call)
Both columns are referencing a different sheet so please excuse any column naming.
I'm not sure if this is going to require VBA or if I can get away with just using a formula, I expect VBA due to desired specifics. I've looked at post like this and this. But neither of these fully encompass what I'm looking for. Especially since I want it to express all the contents in a $B$2:$B$4 case.
My intuition on how to solve this problem tells me, parse the string from Column A for the 1st number then check if it's the end of the string. If it is, feed it to the reference that populates Column B, if not then find the 2nd number and go through a loop that populates the cell (would prefer to keep all the content in one cell in this case) with each value for each reverence.
i.e.
=$B2
=$B3
=$B4
My question is how do I go about this? How do I parse the string? How do I generate the loop that will go through the necessary steps? Such as using the number as a reference to pull information from a different column and feed it neatly into yet another column.
If (for example) you have an address of $X2:$X$4 then
Dim rng As Range
Set rng = yourSheetReference.Range("$X2:$X$4")
If you want to map that to the same rows but column B then
Set rng = rng.Entirerow.Columns(2)
will do that. note: it's not so clear from your question whether you're mapping X>>B or B>>X.
Once you have the range you want you can loop over it:
For Each c in rng.Cells
'do something with cell "c"
next c
Something like this should work for you:
Sub Tester()
Dim shtSrc As Worksheet, c As Range, rng As Range, c2, v, sep
Set shtSrc = ThisWorkbook.Worksheets("Sheet1") '<< source data sheet
Set c = ActiveSheet.Range("A2") '<<range addresses start here
'process addresses until ColA is empty
Do While c.Value <> ""
'translate range to (eg) Column X
Set rng = shtSrc.Range(c.Value).EntireRow.Columns(24)
sep = ""
v = ""
'build the value from the range
For Each c2 In rng.Cells
v = v & sep & c2.Value
sep = vbLf
Next c2
c.Offset(0, 1) = v '<< populate in colB
Loop
End Sub
Try this code:
Sub Test()
Dim fRng As Range ' the cell that has the formula
Set fRng = Worksheets("sheet1").Range("A1")
Dim tWS As Worksheet 'the worksheet that has the values you want to get
Set tWS = Worksheets("sheet2")
Dim r As Range
For Each r In Range(fRng.Formula).Rows
'Debug.Print r.Row ' this is the rows numbers
Debug.Print tWS.Cells(r.Row, "N").Value 'N is the column name
Next
End Sub
I've been working on a user-defined function in VBA to find a certain count. For background, "raw" is a worksheet that refers a sheet that has genres in column B and an artist ID in column C. The sheet that I'm working in has combinations of two genres: first in column A, second in column B.
Anyway, the function that I'm trying to build should do the following:
Take two inputs as strings. Check the genre column in "raw" for matches with the first input. Then, take that ID and find a cell that matches the ID and the second input. If there is one found, add one to a running count. Whether or not it is found, move onto the next match. The function will return an integer that indicates the number of times the two genres had the same artist ID.
Now, my function is returning #VALUE.. no syntax errors, no compiling errors. Just the error in returning the value. I've looked it over, googled like crazy, and I just can't figure it out. I'm new to VBA, so maybe I'm just missing something really obvious or I've defined something wrong. Either way, I just need another set of eyes to look over it. Any suggestions for improvement are much appreciated, so thank in advance for your time and help!!
Here is the code. I know it isn't the prettiest, but it's short and the logic should make sense.
Public Function cocount(c1 As String, c2 As String) As Integer
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim cell1 As Range
Dim ID As Integer
Dim Count As Integer
rng = Worksheets("Raw").Range("B2:B183579")
rng2 = Worksheets("Raw").Range("C2:C183579")
Count = 0
For Each cell In rng
If cell.Value = c1 Then
ID = cell.Offset(0, 1).Value
For Each cell1 In rng2
If cell1.Value = ID And cell1.Offset(0, -1).Value = c2 Then
Count = Count + 1
End If
Next cell1
End If
Next cell
cocount = Count
End Function
EDIT: Thanks for viewing my question and being willing to help (And thanks Rdster for attempting a solution). I uploaded pictures of the raw data and the combination, although it won't let me embed the images. Raw Data Combination List
Anyway, I'll try and explain my problem again. In the combination list of genres, each row contains two genres. I want to find how many times those two genres share the same artist ID in the Raw Data sheet. There are 181,000+ combinations, and 183,000+ rows in the Raw Data. Thus, the function needs to be efficient--something that I'm not incredibly great at doing even in other languages.
This can be achieved using built-in several different Excel Worksheet functions.
Excel Formula using COUNTIFS
Define 2 dynamic named ranges that will resize themselves to fit the data. Gendre_2 is defined relative to Gendre_1 this ensures that the ranges are the same size.
Gendre_1 = OFFSET(Raw!$A$1,1,0,COUNTA(Raw!$A:$A)-1,1)
Gendre_2 = OFFSET(Raw!$A$1,1,1,COUNTA(Raw!$A:$A)-1,1)
Formula
=COUNTIFS(Gendre_1,A2,Gendre_2,B2)
Reference: ExcelJet - Excel COUNTIFS Function
COUNTIFS counts the number of cells in a range that match supplied criteria. Unlike the COUNTIF function, COUNTIFS can apply more than one set of criteria, with more than one range. Ranges and criteria are applied in pairs, and only the first pair is required. For each additional criteria, you must supply another range/criteria pairs. Up to 127 range/criteria pairs are allowed.
VBA
Public Function cocount(c1 As String, c2 As String) As Double
Dim rng As Range, rng2 As Range
With Worksheets("Raw")
Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
Set rng2 = rng.Offset(0, 1)
cocount = WorksheetFunction.CountIfs(rng, c1, rng2, c2)
End With
End Function
If I understand correctly, you are trying to count the number of times that c1 and c2 = B# and C# where # is the same row.
Public Function cocount(c1 As String, c2 As String) As Integer
Dim Count As Integer, iRow as Integer
Count = 0
For iRow = 2 to Sheets("Raw").Cells(Rows.Count, "B").End(xlUp).Row
If Cells(iRow, "B") = c1 And Cells(iRow,"C") = c2 Then
Count = Count + 1
End If
Next iRow
cocount = Count
End Function
Check the genre column in "raw" for
matches with the first input. Then, take that ID and find a cell that
matches the ID and the second input.
try this:
Public Function cocount(FirstKey$, SecondKey$, FirstRng As Range, SecondRng As Range) As Long
Dim FirstAccurance As Range, ID$
Set FirstAccurance = FirstRng.Find(FirstKey, , xlValues, xlWhole, xlByRows, xlNext, 0)
ID = Cells(FirstAccurance.Row, SecondRng.Column).Value2
cocount = WorksheetFunction.CountIfs(SecondRng, ID, FirstRng, SecondKey)
End Function
test:
I am new to Excel Macros and VBA, and am facing the following problem:
(1) I have a data-set which has ~50,000 rows and 11 columns.
(2) I need to extract rows from the sheet, based on a certain keyword - which matches the strings present in a particular column.
(3) I have the following code from another stack overflow question:
Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
(4) This works perfectly fine when the cell of the column being searched has "YourCriteria" as the only entry.
(5) However, in my data I have strings which have the "YourCriteria" embedded in them
For Example: "YourCriteria" = "ball" and the cell(s) in a particular column contain "the dog plays with the ball" , "the ball is bad" etc.
How can I extract the rows containing 'YourCriteria" ? What modification to the code is needed ?
Thanks
To expand on Doug's answer,
If InStr(Cells(r, 2).Value, "YourCriteria")>0 Then 'Found
' ^ Column A=1, B=2, ...
Edit Change 2 to whatever column number you want to look in (C=3, D=4, ...). You can also use Columns("B").Column like you had it, if you're more comfortable with that.
I have found If InStr()>0 to be more reliable than If Instr() since InStr has lots of return-value options.
A general thought, to avoid future problems - rather than switching sheets, refer expressly to which sheet you mean. Example (not all code shown):
dim shSource as Sheet
set shSource = ActiveWorkbook.Sheets("Sheet1")
dim shDest as Sheet
set shDest = ActiveWorkbook.Sheets("Sheet2")
...
If InStr(shSource.Cells(r, 2).Value, "YourCriteria")>0 Then 'Found
shSource.Rows(r).Copy
shDest.Rows(pasteRowIndex).Select
shDest.Paste
There's a built in operator for this in VBA: Like. You can just replace the current test with this:
If Cells(r, Columns("B").Column).Value Like "*YourCriteria*" Then 'Found
InStr( [start], string, substring, [compare] )
Parameters or Arguments
start
Optional. It is the starting position for the search. If this parameter is omitted, the search will begin at position 1.
string
The string to search within.
substring
The substring that you want to find.
compare Optional. It is the type of comparison to perform. It can be one of the following values:
VBA Constant Value Explanation
vbUseCompareOption -1 Uses option compare
vbBinaryCompare 0 Binary comparison
vbTextCompare 1 Textual comparison
borrowed from http://www.techonthenet.com/excel/formulas/instr.php
The fastest way is to:
Apply a Filter to the data
Set a range variable = .SpecialCells(xlCellTypeVisible)
Use range.Copy Sheets("Sheet2").Range("A1") to copy the data straight to Sheet2
Sub DoIt()
Dim SearchRange As Range
Sheets("Sheet1").UsedRange.AutoFilter Field:=2, Criteria1:="=*Ball*", _
Operator:=xlAnd
Set SearchRange = Sheets("Sheet1").UsedRange.SpecialCells(xlCellTypeVisible)
If Not SearchRange Is Nothing Then
SearchRange.Copy Sheets("Sheet2").Range("A1")
End If
End Sub
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.