CODEWITHSUNDEEP
excelvbaexcel-formula
Ichfan Kurniawan
Ichfan Kurniawan

Reputation: 11

Summarize data with loop action

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?

Upvotes: 1

Views: 80

Answers (4)

user3598756
user3598756

Reputation: 29421

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

Upvotes: 0

EEM
EEM

Reputation: 6659

Try using a PivotTable

enter image description here

..........

Upvotes: 1

JMP
JMP

Reputation: 4467

With Microsoft365, Excel for iPad, etc., you have access to the FILTER function:

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")

Upvotes: 1

Gary's Student
Gary's Student

Reputation: 96753

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:

enter image description here

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.

enter image description here

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

Upvotes: 0

Related Questions