I would like to know in vba how to count the row until a particular text "Y" is reached.
For example
I want to capture the value of the row count and use it in the for loop
For example,
For x = x-1 to ctrow
Debug.print ctrow
In the above for loop the value of ctrow should dynamically change to next row count for "Y" value once it reaches the first "Y" value. There is a "Date" field associated with the "Sample data". Once the value "Y" is matched, the date value of the "Date' field will get copied to a different workbook against same "ID" value.
It seems complicated to me. Also i found out other solution but none is working.
Also, if I need to tweak the for loop kindly let me know as well. Thanks a lot.
Sub G()
Dim rng As Range, lr, rngCopy As Range
Set rng = Range("A1").CurrentRegion
rng.Sort key1:=rng(2), Order1:=xlDescending, Header:=xlYes
lr = Columns("B:B").Find("Y", SearchDirection:=xlPrevious).Row
Set rngCopy = Range("A1:B" & lr)
'//Copy results to new sheet
With Sheets.Add(After:=Sheets(Sheets.Count))
.Cells(1).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
End With
End Sub
The code below will accomplish your full task, you must change the worksheet names, columns, and Offset to meet your specific requirements(not enough information provided). The code will first_find a "Y" value in your "Flag" column in the first worksheet. Second_it will loop through each cell in the second worksheet and compare the "ID" in the first worksheet to find a match in the second worksheet. Third_If it finds a match then it uses Offset to select the cell where you want to paste the date from the first worksheet. Then continue looping until the end. If you have problems changing the worksheet, columns, or cells references, please ask.
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim lRow2 As Long
lRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
Set Rng1 = ws1.Range("B2", Cells(Rows.Count, Columns("A:A").Column).End(xlUp))
Dim cel As Range
For Each cel In Rng1
If cel.Value = "Y" Then
For j = 2 To lRow2
If cel.Offset(, -1).Value = ws2.Range("A" & j).Value Then
ws2.Range("A" & j).Offset(, 3).Value = cel.Offset(, 4).Value
End If
Next j
End If
Next cel
Related
I would like to prepare a tool which searches for anything in certain column, and if see anything, copy this value and paste this in few elements on its row
For example if in G2 there is value "ADD", then A2+B2 + E2 + F2 would be an "ADD" to (except C)
Its very hard for me to overcome obstacles, so far I came up with that.. I know this code is hard to bear with but I rarely use VBA so i never had a chance to learn so its mix of what I've found here on stackoverflow combined as per my requirements
Dim wb as Workbook
Dim ws As Worksheet
wb = ActiveWorkbook.Name
ws = Application.ActiveSheet
With ws
Set myRange = Range("G1", Range("G1").End(xlDown))
For i = 1 to myRange
if i <>"" Then
Range("A1", Range("A1").End(xlToRight)).Select
Range("A1", Range("A1").End(xlToRight)).Value = i.text
[I know this part will do from the first element of A to the last but I dont know how to choose elements I wish if they're not one next to each other]
Next i
End with
For what you want to do, it seem you don't need to declare "wb" and "ws". Vba default will use the ActiveSheet. Also wb is declared to be workbook, but ActiveWorkbook.Name is acutally an text. Your code will encounter error.
If you want to loop from G1 to its last inputted cell, you can refer to following code:
For i = 1 To Cells(Rows.Count,7).End(xlUp).Row
The rows.count refer to the last row (1048576) in excel. and "end(xlup)" will find the last cell which inputted value at G column. And the ".row" return the row number of the last cell.
Similarly, you can use "Cells(1, Columns.Count).End(xlToLeft)" to find the last column's cell inputted at row 1
You may try below code:
For i = 1 To Cells(Rows.Count, 7).End(xlUp).Row
If Cells(i, 7).Value <> "" Then
Range(Cells(i, 1), Cells(i, 2)).Value = Cells(i, 7).Value
Range(Cells(i, 4), Cells(i, Columns.Count).End(xlToLeft)).Value = Cells(i, 7).Value
End If
Next i
However, You mention you want to copy except C column. Since I dont know what actual condition that you will not copy to the column. I just simply separate the code into 2 parts, one for A and B column, another one for D to the last columns
One option could be the following:
Sub FindAndCopy()
Dim ws As Worksheet, searchRng As Range, cl As Range, searchTerm As Variant
Set ws = ThisWorkbook.ActiveSheet
With ws
Set searchRng = .Range("G1", .Range("G1").End(xlDown))
searchTerm = "ADD"
For Each cl In searchRng
If cl = searchTerm Then
Range("A" & cl.Row) = searchTerm
Range("B" & cl.Row) = searchTerm
Range("E" & cl.Row) = searchTerm
Range("F" & cl.Row) = searchTerm
End If
Next cl
End With
End Sub
I need to find the value of the last cell in column b of sheet1. This value will change weekly. I then want to take that value and find it in sheet2. Then I want to copy and paste all data below this found value to sheet3. I can't get past the first part with the following code:
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Set cell = Range("B:B").Find("rangefound")
rangefound = lastRow = Cells(lastRow, 2).Value
I've been struggling with the syntax for a month and really don't know what I'm doing.
try this
Sub test()
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
Set cell = Sheet2.Range("B:B").Find(rangefound)
MsgBox "The value was found in Sheet2!" & cell.Address
End Sub
The issues with your code were
using rangefound before it had a value, i.e. the order of the commands
using "rangefound" as a text instead of the variable
wrong syntax to assign a value to rangefound
not qualifying which sheet should be searched
Edit: To extend the code to copy the data below the found value to another sheet, use Offset to reference one row below. There are many different ways to do this, so using Offset is just one option.
Here is the complete code
Sub test()
Dim mycell As Range, RangeToCopy As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
' this is the cell with the found value
Set mycell = Sheet2.Range("B:B").Find(rangefound)
' now find the last row in Sheet2. We can use lastRow again,
' since it is no longer needed elsewhere
lastRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row
' set the range to copy to start one cell below rangefound
' to the end of the data in column B
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' copy the range and paste into Sheet3, starting at A1
RangeToCopy.Copy Sheet3.Range("A1")
End Sub
Note: I changed the variable name from "cell" to "mycell". It's better to use variable names that cannot be mistaken for Excel artifacts.
Another edit: If you need to paste into the next free row in Sheet3, use the techniques already established.
[...]
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' get the next available row in Sheet3
lastRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1
' copy and paste
RangeToCopy.Copy Sheet3.Range("A" & lastRow)
[...]
Note that I'm using the same variable for three different purposes. If that is too confusing, create three distinct variables instead.
I have a cell designated as a Search Box for user entry (called 'UserSearch') and need to be able to use this input to filter multiple columns at the same time. For example, if the user searched for 'Apple', I need the VBA code to filter out all rows where that word appears, even if it appeared in another column. I am currently stuck on only being able to filter out one column at a time but this input may also appear in another column but the row won't be filtered because it may have gotten filtered out by the column before it.
My current code is below is:
Sub search()
With ActiveSheet.Range("$a$4:$j$30")
.AutoFilter Field:=1, Criteria1:="=*" & Range("UserSearch") & "*", Operator:=xlOr
.AutoFilter Field:=2, Criteria1:="=*" & Range("UserSearch") & "*", Operator:=xlOr
.AutoFilter Field:=3, Criteria1:="=*" & Range("UserSearch") & "*"
End With
End Sub
As you can see, my goal is to be able to run autofilter on all 3 fields simultaneously (essentially treating the 3 columns as just one) but the code above contradicts each other and no rows are returned. Anyone have any idea by using autofilter?
You cannot use .AutoFilter for this but yes using a small vba code you can achieve what you want
Let's say your worksheet looks like this
Paste this code in a module
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rngHide As Range
Dim FoundIt As Long, i As Long, lRow As Long
Dim SearchString As String
'~~> Your search string
SearchString = "Apple"
'~~> Change this to the relevant sheet
Set ws = Sheet1
'~~> Find the last row
' https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba
lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
'~~> Loop through 4 to last row to find the search string
For i = 4 To lRow
On Error Resume Next
FoundIt = Application.WorksheetFunction.Match(SearchString, ws.Rows(i), 0)
On Error GoTo 0
'~~> Create a range which needs to be hidden
If FoundIt = 0 Then
If rngHide Is Nothing Then
Set rngHide = ws.Rows(i)
Else
Set rngHide = Union(rngHide, ws.Rows(i))
End If
End If
FoundIt = 0
Next i
'~~> Hide it if applicable
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub
I have commented the code so you should not have a problem understanding it. but if you do then simply ask.
In Action
These two macros are more basic, but accomplish the same task as Sid's answer...
The first macro loops through the range and checks the first three cells in the current row for the search text, if found in any of the cells, it will loop to the next row. If no cells contain the search text, the row will be hidden
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Define your worksheet
Dim UserSearch As String: UserSearch = ws.Range("A2").Value 'Assign the range for the user entry, change as needed
For Each cel In ws.Range("A4", ws.Cells(ws.Rows.Count, 1).End(xlUp)) 'Loop through the range
'Using (= and Or) test if any of the first three cells in the current row contain the search text
If cel.Value = UserSearch Or cel.Offset(, 1).Value = UserSearch Or cel.Offset(, 2).Value = UserSearch Then
'If the search text is found in any of the cells then loop to the next row
Else
'If the search text is not in any of the cells then hide the row
cel.EntireRow.Hidden = True
End If
Next cel
The second macro loops through the range and checks the first three cells in the current row for the search text, if not found, the row will be hidden
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Define your worksheet
Dim UserSearch As String: UserSearch = ws.Range("A2").Value 'Assign the range for the user entry, change the range as needed
For Each cel In ws.Range("A4", ws.Cells(ws.Rows.Count, 1).End(xlUp)) 'Loop through the range
'Using (<> and And) test the first three cells in the current row
If cel.Value <> UserSearch And cel.Offset(, 1).Value <> UserSearch And cel.Offset(, 2).Value <> UserSearch Then
'If the search text is not found hide the current row
cel.EntireRow.Hidden = True
End If
Next cel
I want to get a list of distinct value based on a criteria, example : I have a list of stores, and i want to get only distinct value based on retailer criteria "BOULANGER".
Sub distinctValues()
Dim LastRow As Long
Dim Crit1 As String
LastRow = Sheets("SOURCE").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("SOURCE").Range("B1:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("TEST").Range("E2"), CopyToRange:=Sheets("TEST").Range("A12"), Unique:=True
End Sub
I suspect your Criteria Range is not properly set up and/or named on your worksheet.
In the .AdvancedFilter, you have:
Range(Crit1)
which, according to your code, will be interpreted as:
Range("BOULANGER")
This presumes you have a Named Range somewhere on your Test Worksheet that is named BOULANGER and refers to two cells in a column, the first of which contains Store and the second contains BOULANGER
If you have that set up properly, then your code works.
Note that in your screen shot showing the criteria, the first cell contains Criteria and not Store. So even if you had the defined range setup to encompass those two cells, it would not work since the first row has to have an identical name to the column being filtered.
This should accomplish what you are trying to do; see comments in the code.
Sub ListUniqueValues()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2") 'change as needed
ws1.Range("B1", ws1.Cells(Rows.Count, "B").End(xlUp)).Copy ws2.Range("C1") 'copy the full range from sheet1
ws2.Range("C1", ws2.Cells(Rows.Count, "C").End(xlUp)).RemoveDuplicates Columns:=Array(1), Header:=xlNo 'remove duplicates
Dim lRow As Long
lRow = ws2.Cells(Rows.Count, 3).End(xlUp).Row 'set lastrow variable
For i = lRow To 1 Step -1 'Da Loop, from bottom to top
'change the cell address after "Like" to the cell address where you put your store criteria
'the line will delete any store name that is not like your store criteria
'the (& "*") inserts the wildcard after your store criteria you type in your designated cell, e.g. "BOULANGER*"
If Not ws2.Cells(i, 3).Value Like ws2.Cells(1, 1).Value & "*" Then '
ws2.Cells(i, 3).Delete 'delete the cells that do not match your store criteria
End If
Next i
End Sub
If you are trying to get a unique range that contains a keyword, something like this should work.
Option Explicit
Private Sub OutputUniqueRange(SearchRange As Range, Keyword As String, OutputRange As Range)
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim cell As Range
For Each cell In SearchRange
With cell
If InStr(1, .Value2, Keyword, vbTextCompare) > 0 And Not dict.exists(.Value2) Then dict.Add .Value2, .Value2
End With
Next
If dict.Count = 0 Then Exit Sub
OutputRange.Range(OutputRange.Cells(1, 1).Address).Resize(dict.Count, 1) = Application.Transpose(dict.items())
End Sub
Public Sub TestSub()
Dim SearchRange As Range
Dim Keyword As String
Dim OutputRange As Range
Keyword = "Boulanger"
Set SearchRange = ThisWorkbook.Sheets("Sheet1").Range("A2:A34")
Set OutputRange = ThisWorkbook.Sheets("Sheet1").Range("B2")
OutputUniqueRange SearchRange, Keyword, OutputRange
End Sub
Sub SelectAllReleventText()
Do While Range(“A1”).Offset(1, 6) <> Empty
Rows(ActiveCell.Row).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Here is my script, I've been told it doesn't do what it is meant to, which I expected since this was my first attempt. I am coming up with a variable not defined error. I thought I defined the variable, but I guess it wasn't specific enough for Excel VBA.
This is what I am attempting to do.
In Workbook 1, On B6 there is an alphanumeric name, I want that row to be selected.
Go down one row, if there is text there select that row.
Continue till text is no longer prevalent.
Copy selected rows.
Paste into another workbook (Workbook2), into tab 1, starting on row 2, since row 1 has headers.
Thanks in advance. Just a heads up, I am using the Options Explicit in my VBA because I was told it was the "right way to do thing"...
Yes using Option Explicit is a good habit. Using .Select however is not :) it reduces the speed of the code. Also fully justify sheet names else the code will always run for the Activesheet which might not be what you actually wanted.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim CopyRange As Range
'~~> Change Sheet1 to relevant sheet name
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
Else
Exit For
End If
Next
If Not CopyRange Is Nothing Then
'~~> Change Sheet2 to relevant sheet name
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
End Sub
NOTE
If if you have data from Row 2 till Row 10 and row 11 is blank and then you have data again from Row 12 then the above code will only copy data from Row 2 till Row 10
If you want to copy all rows which have data then use this code.
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim CopyRange As Range
'~~> Change Sheet1 to relevant sheet name
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
End If
Next
If Not CopyRange Is Nothing Then
'~~> Change Sheet2 to relevant sheet name
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
End Sub
Hope this is what you wanted?
Sid
The easiest way to do it is to use the End method, which is gives you the cell that you reach by pressing the end key and then a direction when you're on a cell (in this case B6). This won't give you what you expect if B6 or B7 is empty, though.
Dim start_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Range(start_cell, start_cell.End(xlDown)).Copy Range("[Workbook2.xlsx]Sheet1!A2")
If you can't use End, then you would have to use a loop.
Dim start_cell As Range, end_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Set end_cell = start_cell
Do Until IsEmpty(end_cell.Offset(1, 0))
Set end_cell = end_cell.Offset(1, 0)
Loop
Range(start_cell, end_cell).Copy Range("[Workbook2.xlsx]Sheet1!A2")