VBA Filter Names from List One by One and then Copy filtered data

[Sufiyan97]

I have a data like below

I a VBA to Filter Names from List (J16:J20) One by One and then Copy the filtered data:

Book1
	C	D	E	F	G	H	I	J	K	L
1		Name	Amount
2		A	5
3		A	5
4		B	10
5		B	10
6		C	15
7		C	15
8		D	20
9		D	20
10		E	25
11		E	25
12
13		Total Quantity	150
14		Total Amount	4500
15
16								A
17								B
18								C
19								D
20								E
21
22
23
24
25
Sheet1

Cell Formulas
Range	Formula
E13	E13	=SUBTOTAL(9,E2:E11)
E14	E14	=E13*30

 

[Anthony47]

And where the filtered data has to be copied?

 

[Sufiyan97]

I want to send the copied data to specific number on WhatsApp

 

[Anthony47]

The following macro can manage the filter process:

Sub SeqFilter()
Dim fRange As Range, kArea As Range
Dim fArr, I As Long, cFilt
'
Set fRange = Range(Range("D1"), Range("D1").End(xlDown).Offset(0, 1))
'
For I = 16 To 1000
    cFilt = Cells(I, "J").Value
    If Len(cFilt) = 0 Then Exit For
    fRange.AutoFilter Field:=1, Criteria1:=cFilt
    fArr = fRange.Cells(2, 1).Resize(fRange.Rows.Count - 2, 2).SpecialCells(xlCellTypeVisible).Value
    '
    'Now the filtered row have been saved in array fArr
    '...ready to be copied where you prefer
    '
Next I
fRange.AutoFilter Field:=1
End Sub

After each filtering the filtered data are copied into fArr, and are available to be copied.
You probably already know how to interface WhatsApp, so I shall not enter that area

 

[Sufiyan97]

Hi Anthony47,

Thanks for you time and help!

The above VBA fully runs in one go.
1. What happens when I run it, it filters each name in column J within in less than in second and then comes back to original data i.e. cleared filter.
2. It does not copy the data when I open VBA editor and run in step by step with F8.

What I want is I want filter first name, then copy the data, then paste it to WhatsApp, then when again when I run it, I want second name to be filtered and so on.
I don't know is it possible or not. if it is then please help in this.

I don't know how to interface WhatsApp, if you also know about that, please add that part also, otherwise I will manage.

 

[Anthony47]

If it had been clear from the beginning that you want to send filtered data via whatsapp, and not "copy" it somewhere in the excel environment, I would not have entered the discussion ...
We could interact using web.whatsapp.com and Selenium, but these type of interaction last for a day /a week /a month and then require to be adapted to the evolved web page.

What I can do is switch to the following code, that copy into the windows clipboard the filtered text:

 [code] Sub SeqToClip()
Dim fRange As Range, kArea As Range
Dim fArr As String, I As Long, cFilt, J As Long
'
Set fRange = Range(Range("D1"), Range("D1").End(xlDown).Offset(0, 1))         'Assumes
'
For I = 16 To 1000
    cFilt = Cells(I, "J").Value
    If Len(cFilt) = 0 Then Exit For
    fArr = ""
    For J = 1 To fRange.Rows.Count
        If fRange.Cells(J, 1).Value = cFilt Then
            fArr = fArr & fRange.Cells(J, 1).Value & " - " & fRange.Cells(J, 2).Value & vbCrLf
        End If
    Next J
    SetClipBoardText (fArr)   'fRange.Cells(2, 1).Resize(fRange.Rows.Count - 2, 2).SpecialCells(xlCellTypeVisible).Value)
'
    If Len(fArr) > 2 Then
        Beep
        MsgBox ("Copy the clipboard data into WhatsApp Web; User: " & Cells(I, "J").Value)
    End If
'
Next I
MsgBox ("Completed")
End Sub


Function SetClipBoardText(ByVal Text As Variant) As Boolean
    SetClipBoardText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text)
End Function

It uses the function SetClipBoardText that i found here: VBA Post to Clipboard
The macro will copy to the clipboard the data for the filtered name, and a message box will inform that data are ready, along with the name currently used as filter.
It is up to you to activate the web.whatsapp.com page and link the page to your account, select the destination, use Contr-c to paste the clipboard into the "New message" box and send the message. At that point you close the messagebox and the macro will fetch the text for the next filter, until the "Completed" message is received.

Bye

 

[Sufiyan97]

If it had been clear from the beginning that you want to send filtered data via whatsapp, and not "copy" it somewhere in the excel environment, I would not have entered the discussion ...

I am sorry for not clearing that.
But that is not an issue

The above code in works perfectly for filtering ad copying filtered data.

Thank you very much for that.

Can you please add one more thing:
I want to copy Total Quantity and Total Amount as well with the filtered data, can you please add that as well.

 

[Anthony47]

Can you please add one more thing:
I want to copy Total Quantity and Total Amount as well with the filtered data, can you please add that as well.

Assuming the two additional information are below the main table but separated by one empty row, try this version:

Sub SeqToClip_V2()
Dim fRange As Range, kArea As Range
Dim fArr As String, I As Long, cFilt, J As Long
'
Set fRange = Range(Range("D1"), Range("D1").End(xlDown).Offset(0, 1))   'Assuming the table starts in D1
'
For I = 16 To 1000
    cFilt = Cells(I, "J").Value
    If Len(cFilt) = 0 Then Exit For
    fArr = ""
    For J = 1 To fRange.Rows.Count
        If fRange.Cells(J, 1).Value = cFilt Then
            fArr = fArr & fRange.Cells(J, 1).Value & " - " & fRange.Cells(J, 2).Value & vbCrLf
        End If
    Next J
    DoEvents
'
    If Len(fArr) > 2 Then
        fArr = fArr & fRange.Cells(J + 1, 1).Value & " - " & fRange.Cells(J + 1, 2).Value & vbCrLf
        fArr = fArr & fRange.Cells(J + 2, 1).Value & " - " & fRange.Cells(J + 2, 2).Value & vbCrLf
        SetClipBoardText (fArr)   'fRange.Cells(2, 1).Resize(fRange.Rows.Count - 2, 2).SpecialCells(xlCellTypeVisible).Value)
        Beep
        MsgBox ("Copy the clipboard data into WhatsApp Web; destination: " & Cells(I, "J").Value)
    End If
'
Next I
MsgBox ("Completed")
End Sub

 

[Sufiyan97]

Hii

Getting below error

 

[Sufiyan97]

One another thing can you please update, current filter is based on exact match, it is case sensitive, can we make it case unsensitive??

and for example in excel inbuilt filter when we search in filter "John", then we will get all the results for "John" like, "John wick Other text", "Other Text John Wick" etc.

Can we modify the code so that it can search everything based on value in column J like excel inbuilt filter?

Like if there is a text "Anthony" in column J, it will filter everything ignoring lower and upper case and will filter : "Anthony Gonzalez", "Gonzalez Anthony", "Other text Gonzalez Anthony Other text"


Sorry to bother you again and again but this will be very helpful for me.