VBA Code to gte the values by multiple filtering

[Wafee]

Hi, Can someone help me with VBA code that does the below.

I have two sheets where one is source and another is output. I will update source sheet weekly and VBA should update output.
Source sheet looks as below. it will have both current week's and past weeks data.

​

Column H	Column J	Column U	Column V
WEEK_END_DATE​	Sales​	Senior Manager​	Manager​
10/17/2020​	40​	Hari​	Max​
10/17/2020​	30​	Sam​	James​
10/17/2020​	60​	Hari​	Max​
10/17/2020​	10​	Hari​	Colin​
10/17/2020​	20​	Hari​	Jade​
10/17/2020​	40​	Sam​	Varun​
10/17/2020​	50​	Sam​	James​
10/17/2020​	70​	Sam​	Murat​
10/10/2020​	70​	Sam​	Murat​

my output sheet looks as below. below steps needs to be done.

1. Find the Report date from the cell Y2 (10/17/20) and needs to find out where is that date in first row (In this case it is "D" row. this is where values to be entered)
2. now pick a name from column A from output sheet and look for the same in either column U or V in source sheet and then filter the report date in column H of source sheet and sum of respective sales amount to be published in cells of "D" row.

​

Column A	Column B	Column C	Column D		Column Y
Senior Manager/Manager​	10/3/2020​	10/10/2020​	10/17/2020​	​	Report date​
Hari​	80​	60​	130​	​	10/17/2020​
Max​	40​	40​	100​	​	​
Colin​	40​	20​	10​	​	​
Jade​	​	​	20​	​	​
Sam​	90​	80​	190​	​	​
Varun​	20​	30​	40​	​	​
James​	20​	20​	80​	​	​
Murat​	30​	20​	70​	​	​
Jade​	20​	10​

I have posted a similar query before but it was bit complicated and haven't recived any responses. this time made my requirement simpler. Thnak you in adavance.

 

[mumps]

Insert this line of code:

desWS.Cells(man.Row, fndDate.Column) = fnd.Offset(, -2)

directly below this line:

Set fnd = srcWS.Range("D" & fVisRow & ":D" & lvisrow).Find(man, LookIn:=xlValues, lookat:=xlWhole)

 

[Wafee]

Insert this line of code:

desWS.Cells(man.Row, fndDate.Column) = fnd.Offset(, -2)

directly below this line:

Set fnd = srcWS.Range("D" & fVisRow & ":D" & lvisrow).Find(man, LookIn:=xlValues, lookat:=xlWhole)

Hi Mumps, thank you so much for your efforts, it was of great help to me.

below is the output i have got. Couple of things here.

1. for senior managers while calcuating the sales amount it has to filter the report date and calculate but it is summing up whole amount irrespective of report date

2. for managers it is pulling the first resulted sales amount rather than adding if multiple lines exist.

3. I have added Jade under Hari in output manually and ran the code but the code is still adding a duplicate line for Jade.

Samplexl.xlsm
	A	B	C	D	E	F	G
1	Senior Manager	Manager	10/3/2020	10/10/2020	10/17/2020		Report date
2	Hari		80	60	130		10/17/2020
3		Max	40	40	60
4		Colin	40	20	10
5		Jade
6	Sam		90	80	270
7		Varun	20	30	40
8		James	20	20	30
9		Murat	30	20	70
10		Jade	20	10	20
Output

 

[mumps]

Try:

Sub CopyValues()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lRow As Long, srcWS As Worksheet, desWS As Worksheet
    Dim fnd As Range, man As Range, srMan As Range, i As Long, y As Long, x As Long: x = 1
    Dim fVisRow As Long, fndDate As Range, rng As Range, total As Long, val As String
    Set srcWS = Sheets("Source")
    Set desWS = Sheets("Output")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With desWS
        Set fndDate = .Rows(1).Find(.Range("G2"))
        If Not fndDate Is Nothing Then
            With srcWS
                .Cells(1, 1).CurrentRegion.AutoFilter 1, CStr(fndDate)
                fVisRow = .Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
                lvisrow = .Cells(.Rows.Count, "A").End(xlUp).Row
                With desWS.Range("B3:B" & LastRow).SpecialCells(xlCellTypeConstants).Areas
                    For i = 1 To .Count
                        fr = .Item(i).Row
                        val = desWS.Cells(fr - 1, 1)
                        cnt = .Item(i).Cells.Count
                        For Each man In desWS.Range("B" & fr).Resize(cnt)
                            Set fnd = srcWS.Range("D" & fVisRow & ":D" & lvisrow).Find(man, LookIn:=xlValues, lookat:=xlWhole)
                            With srcWS
                                .Cells(1, 1).CurrentRegion.AutoFilter Field:=4, Criteria1:=fnd
                                .Cells(1, 1).CurrentRegion.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, fndDate)
                                For Each rng In .Range("B2:B" & lRow).SpecialCells(xlCellTypeVisible)
                                    total = total + rng.Value
                                Next rng
                                .Range("A1").AutoFilter
                                desWS.Cells(man.Row, fndDate.Column) = total
                                total = 0
                            End With
                            If Not fnd Is Nothing Then
                                If WorksheetFunction.CountIf(desWS.Range("B:B"), man) = 1 Then
                                    If fnd.Offset(, -1) <> val Then
                                        Set srMan = desWS.Range("A:A").Find(fnd.Offset(, -1), LookIn:=xlValues, lookat:=xlWhole)
                                        If Not srMan Is Nothing Then
                                            y = desWS.Range("B" & srMan.Row + 1 & ":B" & LastRow).Cells.SpecialCells(xlCellTypeBlanks).Row
                                            desWS.Rows(y).EntireRow.Insert
                                            desWS.Cells(y, 2) = man
                                        End If
                                    End If
                                End If
                            End If
                        Next man
                    Next i
                End With
            End With
        End If
        srcWS.Range("A1").AutoFilter
        For Each srMan In .Range("A2:A" & LastRow)
            If srMan <> "" Then
                Set fndDate = .Rows(1).Find(.Range("G2"))
                If Not fndDate Is Nothing Then
                    Set fnd = srcWS.Range("C:C").Find(srMan, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        With srcWS
                            .Cells(1, 1).CurrentRegion.AutoFilter 3, fnd
                            .Cells(1, 1).CurrentRegion.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, fndDate)
                            For Each rng In .Range("B2:B" & lRow).SpecialCells(xlCellTypeVisible)
                                total = total + rng.Value
                            Next rng
                            .Range("A1").AutoFilter
                        End With
                        .Cells(srMan.Row, fndDate.Column) = total
                        total = 0
                    End If
                End If
            End If
        Next srMan
    End With
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Wafee]

H

Set fndDate = .Rows(1).Find(.Range("G2")) If Not fndDate Is Nothing Then

Hi Mumps,

For some reason this fnddate is not working properly. Is it possible to make it as user input thing where code ask user for the date to be entered?

 

[mumps]

The macro worked properly for me. Make sure that the date in G2 and the dates in row 1 are all formatted as dates. If that still doesn't work, perhaps you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[Wafee]

The macro worked properly for me. Make sure that the date in G2 and the dates in row 1 are all formatted as dates. If that still doesn't work, perhaps you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Hi Mumps,

Sorry for getting back late but the code worked for me thank you so much. can you please help me with the code that only does amendments to senior manager and manager if at all there is any addition (if there a new senior manager the he/she should be added in column A of "Output" sheet. if there a new manager then he/she should be added in column B under respective senior manager ).

I tried to extract above from the code you have provided but I am failing to that. would be greatful if you can help.