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]

For some reason, when I copy/paste the data you posted, each value contains an invisible question mark at the end. Is your data manually entered into your workbook? It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file 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. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Wafee]

Hi Mumps, Sorry for all the trouble. below are the input and output sheets(Chnaged few things to make it simpler). Below are the steps that needs to be done. Output sheet will basically be amended with new weekdata without altering any existing data.

1. take the date from Report date column (G) in the output sheet and filter the same in weekending column (A) in inputsheet.

2. Take the list of Senior Managers and their respective Managers from the above filtered data and needs to cross check with the output sheet list (Column A and Column B) and if there is any changes that needs to be added.(In this case Jade was under Sam and for the week 10/17/20 he moved under Hari so new line to be added in "B" column of output sheet adding Hari. no need to remove Jade from Sam as he got previous data from previous week )

3. Once Manager related Changes are done we have find out in which column data needs to be entered by looking for Reporting date(10/17/20) in 1 st row of output sheet. in this case it is column "E".

4. Finally, Sales amount needs to be pulled from input sheet. For senior Managers filter name and report date value needs to be pulled. for Managers - name, report date and respective senior manager name also needs be filtered and respective sum of sales amount needs to be pulled.

Please consider to skip step 2 if it is not possible mate. Thank you in advance.




Input sheet.

Samplexl.xlsx
	A	B	C	D
1	WEEK_END_DATE	Sales	Senior Manager	Manager
2	10/17/2020	40	Hari	Max
3	10/17/2020	30	Sam	James
4	10/17/2020	60	Hari	Max
5	10/17/2020	10	Hari	Colin
6	10/17/2020	20	Hari	Jade
7	10/17/2020	40	Sam	Varun
8	10/17/2020	50	Sam	James
9	10/17/2020	70	Sam	Murat
10	10/10/2020	70	Sam	Murat
11	10/10/2020	20	Hari	Jade
Sheet1

output sheet.

Samplexl.xlsx
	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	100
4		Colin	40	20	10
5		Jade			20
6	Sam		90	80	190
7		Varun	20	30	40
8		James	20	20	80
9		Murat	30	20	70
10		Jade	20	10
Sheet2

 

[Wafee]

For some reason, when I copy/paste the data you posted, each value contains an invisible question mark at the end. Is your data manually entered into your workbook? It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file 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. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Hi Mumps, Could you please help me with the request.

 

[mumps]

This macro is based on the data you posted in Post #3:

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)
                            If Not fnd Is Nothing 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
                        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
                            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]

This macro is based on the data you posted in Post #3:

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)
                            If Not fnd Is Nothing 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
                        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
                            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

Thank you for the response Mumps. Will run the code and get back to you.

 

[Wafee]

total = total + rng.Value

Hi Mumps, getting a type mismatch error at the above line. Anything you can help!! Thank you in advance.

 

[mumps]

When you get the error, hover the mouse over "total". What do you see? Hover the mouse over "rng.value". What do you see?

 

[Wafee]

Sorry the above mentioned error was due to the invisible question mark (my bad), I have corrected it and code ran successfully. but i have only got the the sales amount for Senior Manager and for manager respective cells are empty.

When you get the error, hover the mouse over "total". What do you see? Hover the mouse over "rng.valueSorry that error was due to

 

[Wafee]

Sorry the above mentioned error was due to the invisible question mark (my bad), I have corrected it and code ran successfully. but i have only got the the sales amount for Senior Manager and for manager respective cells are empty.

Also If i add Jade under Hari and run the code it is still adding additional line with for Jade which is a duplicate.