I have a list of fruit in A1:A20, & then the user of my excel file will give the check mark ("V") in B1:B20 if they want to choose one of fruit in the list of column A.
The problem is I want automatically to summarise in sheet2 a list of fruit which the user give the check mark in column B. Do you guys any idea how to solve it?
With Microsoft365, Excel for iPad, etc., you have access to the FILTER function:
FILTER
You set the data range you want to use as a result set, and then set the criteria to filter by, in your case Sheet1!A1:A20 and Sheet1!B1:B20="v" respectively.
Place this in A1 on Sheet2, and the list is created and then automatically updated.
=FILTER(Sheet1!A1:A20,Sheet1!B1:B20="v")
Try using a PivotTable
..........
This uses a "helper column". In Sheet1 cell C1 enter:
=IF(B1<>"",1,0)
In Sheet1 cell C2 enter:
=IF(B2="","",1+MAX(C1:$C$1))
and copy downwards. A typical example:
Note that column C marks the selected fruits with a simple sequential inter sequence.
Finally in `Sheet2 cell A1 enter:
=IF(ROWS($1:1)>MAX(Sheet1!C$1:C$20),"",INDEX(Sheet1!A$1:A$20,MATCH(ROWS($1:1),Sheet1!C$1:C$20),0))
and copy downwards.
If you need VBA for another reason then:
Sub qwerty()
Dim i As Long, rng As Range, r As Range
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set rng = s1.Range("B1:B20")
i = 1
For Each r In rng
If r.Value <> "" Then
s2.Cells(i, 1).Value = r.Offset(0, -1).Value
i = i + 1
End If
Next r
End Sub
you could place this in Sheet1 code pane (rightclik on Sheet1 tab and select "View Code")
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B20")) Is Nothing Then Exit Sub
With Sheet2
.Range("A1:A20").ClearContents
Dim cel As Range
For Each cel In Range("A1:A20")
If cel.Offset(, 1) = "v" Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Value = cel.Value2
Next
End With
End Sub
this way, everytime the user operates on Sheet1 B1:B20 cells, the Sheet2 list is automaticaly updated
Related
I want to look through a table in a sheet. Find each cell with "Yes" in it, when one is found. Paste a Yes to A1, when another is found A2, etc...
I was trying to modify this code to search all cells instead of just Row A
Following code should give you the headstart
Sub Text_search()
Dim Myrange As Range
Set Myrange = ActiveSheet.UsedRange
For Each cell In Myrange
If InStr(1, cell.Value, "YES") > 0 Then
'do something
Else
'do something else
End If
Next
End Sub
Further to #isomericharsh's answer, if it's a table you're looking through, that simplifies defining the range; just use DataBodyRange.
If the table 'Table1' is on 'Sheet1' and the results are to be posted on 'Sheet2' then I'd do as follows:
Sub Search_for_Yes()
Dim YesAmt As Long ' - Amount of yes's found
YesAmt = 0 'to start with
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
'It's always safer to use specific references rather than ActiveSheet
For Each cell In ws1.ListObjects("Table1").DataBodyRange 'The data in the table excluding headings and totals
If cell.Value = "YES" Then 'might need to add wildcards to this if you want to include cells that contain yes as part of larger text string. Also note that it's case-specific.
ws2.Cells(1 + YesAmt, 1).Value = "Yes" 'so that each time a yes is found it will log it further down
YesAmt = YesAmt + 1
End If
Next
x = MsgBox(YesAmt & " values found and listed", vbOKOnly + vbInformation)
End Sub
Does that help?
I am trying to identify duplicates in Excel. I can highlight all duplicates in a column, using standard excel tools.
Ideally I would like to, say, click in cell A3 and have excel instantaneously highlight all instances in column A, which are duplicates of A3. This should happen in "real-time".
If you wanted a VBA solution to this problem you could try the below, but as noted already by PEH this would not be ideal with a large amount of data.
This would have to be applied to the sheet you're using and assumes that you're only assessing Column A.
Note: It will check Column A any time a cell on the sheet is double clicked...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Name your sheet here
SheetName = "Sheet1"
'Work out how many rows there are in Column A
LastRow = Sheets(SheetName).Cells(Rows.Count, 1).End(xlUp).Row
'Copy current value to check later
CheckValue = Selection.Value
'Validate there is more than 1 filled cell
If LastRow > 1 Then
'Redim an array to hold all Column A data then load it to the array
ReDim DataArray(1 To LastRow) As Variant
DataArray = Range(Sheets(SheetName).Cells(1, 1), Sheets(SheetName).Cells(LastRow, 1))
'Clear previous highlighting
Range(Sheets(SheetName).Cells(1, 1), Sheets(SheetName).Cells(LastRow, 1)).Interior.Pattern = xlNone
'loop through array highlighting cells that match the "CheckValue"
For I = 1 To LastRow
If DataArray(I, 1) = CheckValue Then
Sheets(SheetName).Cells(I, 1).Interior.ColorIndex = 4
End If
Next I
End If
End Sub
It's likely a more elegant solution exists.
quick and dirty, place this in the wanted sheet code pane:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column > 1 Then Exit Sub
Dim cellsToHighlight As Range, cell As Range
Set cellsToHighlight = Range("B1")
For Each cell In Range("A1", Cells(Rows.Count, 1).End(xlUp))
If cell.Value2 = Target.Value2 Then Set cellsToHighlight = Union(cellsToHighlight, cell)
Next
Set cellsToHighlight = Intersect(cellsToHighlight, Columns(1))
If Not cellsToHighlight Is Nothing Then cellsToHighlight.Select
End Sub
Use conditional formating for "Duplicate Values"
So I'm working on an excel sheet, and this is something i really can't figure out.
I want it to be that if the contents of a cell match certain criteria, an entire column of cells will be pasted according to that cell. The cell is a drop down with 32 different options (that can be reduced if theres no way to do it) and each option corresponds to a different column of data. The columns that have to be pasted have roughly 32 cells of data each.
My current formula is basically =IFS(A1="Potato",Sheet2!G:G) but this gives me a '0'. The best i can do is change the formula to =IFS(A1="Potato",Sheet2!G1) or =IFS(A1="Potato",Sheet2!G1:G32) but both of these formulas give me the contents of the first cell only (G1).
Any ideas on how I could get this done without having to contact aliens or build a spaceship?
You can use formulas, or VBA.
I have assumed your 32 columns of source data are in Sheet2 with the headers in row 1.
Formula Solution
In Sheet1 A73, enter:
=INDEX(Sheet2!$A$1:$AF$41,ROW(A1),MATCH($A$1,Sheet2!$A$1:$AF$1,0))
Copy this formula to Sheet1 A74:A105
VBA Solution
Put this code in the Sheet1 module;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
With Sheet2
Set c = .Rows(1).Find(what:=Sheet1.Range("A1").Value)
If Not c Is Nothing Then
Set c = Intersect(.UsedRange, c.EntireColumn)
Sheet1.Range("A73").Resize(c.Rows.Count, 1).Delete
c.Copy Sheet1.Range("A73")
End If
End With
Application.EnableEvents = True
End If
End Sub
EDITED ANSWER: (according to comment)
We have the following layout of products
Private Sub CommandButton1_Click()
'first we check the user input
Dim u_input As String
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
u_input = LCase(Trim(ws.Range("A1").Value2))
'now we need to determine how many columns there are so we know when to stop looping
Dim lc As Long, lr As Long
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' loops through all the products
For Each cell In Range(Cells(1, "F"), Cells(1, lc))
' if the product matches the input
If LCase(Trim(cell)) = u_input Then
lr = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
' copy and paste the active data range to A37
ws.Range(Cells(1, cell.Column), Cells(lr, cell.Column)).Copy
Sheets("Sheet2").Range("A37").PasteSpecial
End If
Next cell
End Sub
So, upon entering cucumber and clicking the button:
We would get the following result:
You can add any number of products there, as long as the first product starts in column F. (though that can also be changed in code).
PS: This will however end up overwriting your data and also cause data to overlap if your data ranges are not the same. It probably would be smarter to paste the data into the next empty row in sheet2 instead of directly to A37
This can be achieved by changing the line
Sheets("Sheet2").Range("A37").PasteSpecial to Sheets("Sheet2").Range(Cells((Rows.Count, "A").End(xlUp).Row, "A")).PasteSpecial
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
Need help here with a macro..
We have at column A all the data starting from A2. What we want to do is create a loop that if column A has value will copy A2 to B2, A3 to B3 and so on. A copy - paste macro wont help us because we filter the data of column A at our existing macro and if we copy and paste it at column B it will not paste the value right next to it.
So we want a loop that scans all column A, finds the non empty and when it finds a value paste it right to the next field. For example A335 to B335 and when it goes to the end of A to stop.
Thank you in advance!
Try this code:
Sub CopyToRight()
Dim rng As Range
Dim LastRow As Long
Dim cell As Variant
LastRow = ActiveSheet.Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:A" & LastRow)
For Each cell In rng
If cell.Value <> "" Then
cell.Offset(0, 1).Value = cell.Value
End If
Next cell
End Sub