# Find the lesser closest date by given date and then multiply the intersect values.

#### Anbuselvam K

##### Member
Hi

I need a VBA code to get the below results.

In the attached workbook

Sheet1, Cell D9 is the given date and the cell B12: H12 is the data range

Sheet2 A2: A15 is the list of dates where we need to lookup by VBA code

In the list of dates in Sheet2, none is matching Sheet1, D9 dates of 13-Mar-19. So then It has to select the closest lesser dates of D9(13-Mar-19) which is (09-Mar-19)

Then the intersecting values of B2: H15 need to multiply by Sheet1 cell B12: H12 values and the results must be shown in D10 of Sheet 1.

If same Date present in the list then the same date intersecting values to multiply.

Hope someone will guide me to get the VBA Code.

#### Attachments

• 12.3 KB Views: 3

#### Anbuselvam K

##### Member
I would like to convert my daily working sheet from normal excel formulas to VBA code as I want to write and learn the working VBA code.

I am just beginner in the VBA code writing. Your help will be very grateful for me.

#### Marc L

##### Excel Ninja
Hi !​
Once the date is found, clearly elaborate what should be done, any formula sample with an expected result ?​

#### GraH - Guido

##### Well-Known Member
I guess formula in B13 can be =B12*INDEX(Sheet2!\$B\$2:\$I\$15,MATCH(\$D\$9,Sheet2!\$A\$2:\$A\$15,1),COLUMN(A1))
Simple recording of macro reveals following code (which now can be improved):
Code:
``````Range("B13").Select
Selection.FormulaR1C1 = _
"=R[-1]C*INDEX(Sheet2!R2C2:R15C9,MATCH(R9C4,Sheet2!R2C1:R15C1,1),COLUMN(R[-12]C[-1]))"
Selection.AutoFill Destination:=Range("B13:I13"), Type:=xlFillDefault``````
Slightly better perhaps like so
Code:
`````` With Range("B13")
.FormulaR1C1 = _
"=R[-1]C*INDEX(Sheet2!R2C2:R15C9,MATCH(R9C4,Sheet2!R2C1:R15C1,1),COLUMN(R[-12]C[-1]))"
.AutoFill Destination:=Range("B13:I13"), Type:=xlFillDefault
End With``````
But for this simple set-up I would simply use a formula-approach.

#### Anbuselvam K

##### Member
Dear GraH Guido

As I want to learn the VBA Code writing,

Can we write the code without using application functions like index and match? Because I want to write the working pure VBA code without using any of the functions as an index match.

Dear Marc L
The expected to result in sheet1 cell D10 is: 281.95 (Check the attached file)

Thanks in advance for you both.

#### Attachments

• 12 KB Views: 3

#### Marc L

##### Excel Ninja
As a « pure VBA code » is often less efficient and sometimes slower than using Excel inner features …​
Paste this code to the Sheet1 worksheet module :​
Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
V = [MATCH(Sheet1!D9,Sheet2!A:A,1)]
With Target(2)
If IsError(V) Then .Value2 = "" Else .Value2 = Evaluate(Replace("SUMPRODUCT(Sheet1!B12:I12,Sheet2!B#:I#)", "#", V))
End With
End If
End Sub``````
Do you like it ? So thanks to click on bottom right Like !​

#### Anbuselvam K

##### Member
Dear Marc L

Check the attachment for your study. it is not giving proper results in the cell D10

Also, the code has an application function of sumproduct which I do not require.

I want the code without using the sumproduct index and match functions.

I hope you can provide an alternate one.

My intention is to learn the pure working VBA code instead of using the same excel formulas inside the codes.

#### Attachments

• 15.7 KB Views: 3

#### Marc L

##### Excel Ninja
As it works on my side with your first attachment so you just pasted the code in Sheet2 instead of Sheet1.​
To well understand your error, rename Sheet1 as Date for example, whatever, then check it out !​
Once code is located at the right place, rename the worksheet as original or mod the code …​
If if is only an exact search, VBA has its `Find` method.​
But for your purpose, VBA has nothing to directly find your row, the reason why using Excel stuff is the best way !​
So if you really want a « pure VBA code » (totally silly but as usual on any forum) explain in plain english text​
what "strategy" you want to apply in order to achieve a very less efficient code ?​
If it respects Logic, I'll try to code that like any very beginner Dumb or Dumber can …​

#### Anbuselvam K

##### Member
Dear Marc L

After finding the date in column A, Can we use

Set B2I15= Intersect(Columns("B:I"), A.EntireRow)

The below code is for sumproduct formulas results by pure VBA code for your information.

The sum-product formula is =IF(P1=EN2,(SUMPRODUCT((J8:J30495<=EN1)*(J8:J30495>=EO1)*(G8:G30495="Sales")*CF8:CF30495))

But in my case, I need to write the code for SUMPRODUCT and INDEX,MATCH as like below formulas

=IF(P1=EN6,(SUMPRODUCT(CG4:EF4,INDEX('RM Price'!\$B\$2:\$BA\$239,MATCH('Master Data'!\$EN\$1,'RM Price'!\$A\$2:\$A\$239),))

Code:
``````Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim J As Range, G As Range, Where As Range
Dim Low As Date, High As Date
Dim Dates, Types, Values
Dim i As Long
Dim Sum As Double, Sum1 As Double, Sum2 As Double

'Only if P1 changes
If Intersect(Target, Range("P1")) Is Nothing Then Exit Sub

'Get the dates
Low = Range("EO1").Value
High = Range("EN1").Value
'Refer to the used cells in column J
Set J = Range("J8", Range("J" & Rows.Count).End(xlUp))
'Same size in column G
Set G = Intersect(Columns("G"), J.EntireRow)
Dates = J.Value
Types = G.Value

Select Case Target.Value
Case Range("EN2").Value
'Same size in column CF
Set Where = Intersect(Columns("CF"), J.EntireRow)
Values = Where.Value
'Process the SUMPRODUCT
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next
End Select

'Events off, otherwise we call ourself
Application.EnableEvents = False
'Write the sum into the sheet
Range("EL7") = Sum
'Events on
Application.EnableEvents = True
End Sub``````

#### Marc L

##### Excel Ninja
`Set B2I15= Intersect(Columns("B:I"), A.EntireRow)`
Maybe but I wanna see the codeline where this variable object A is filled …​
A better way if A is a cell within the first column : `Set B2I = A(1, 2).Resize(, 8)` …​

#### Anbuselvam K

##### Member
Sorry, I don't know further how to multiply the intersect values and where the object A is filled.

#### Marc L

##### Excel Ninja
Solution is already within post #6 following the TEBV main rule (Think Excel Before VBA !) …​
Pro avoid to use any loop when Excel has yet all the necessary : easy code,​
easier to maintain than any gas factory pure VBA code …​
If you want another solution way then follow post #8 : explain in plain english text your logic.​

#### Marc L

##### Excel Ninja
The below code is for sumproduct formulas results by pure VBA code
In fact your code is very not at pure VBA level !​
As a reminder VBA means Visual Basic for Application (here Application is of course Excel).​
So your code is more like a car with a wheel off …​
According to your last attachment from post #7, a pure code at Application level :​
Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
V = Application.Match(Target, Sheet1.UsedRange.Columns(1), 1)
If IsError(V) Then [D10].Value2 = "" Else [D10].Value2 = Application.SumProduct([B12:I12], Sheet1.Cells(V, 2).Resize(, 8))
Application.EnableEvents = True
End If
End Sub``````
You may Like it !

#### Marc L

##### Excel Ninja
To any reader : next code is not the way to go …​
To Anbuselvam K : a demonstration that pro avoid :​
Code:
``````Function BadlyFindRow(D As Date) As Range
Const C = "B:I"
Dim R&
With Sheet1.[A1].CurrentRegion.Rows
For R = 2 To .Count
Select Case .Cells(R, 1).Value
Case D
Exit Function
Case Is > D
Set BadlyFindRow = .Item(R + (R > 2)).Columns(C)
Exit Function
End Select
Next
End With
End Function

Dim Rg As Range, D#
D = D + Sheet2.Cells(12, Rg.Column).Value2 * Rg.Value2
Next
Sheet2.[D10].Value2 = D
End Sub``````
You should Like it !

#### Fluff13

##### Active Member
An equally bad idea, that I supplied on MrE
Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range, FndRw As Range
Dim i As Long
Dim MySum As Double

If Target.CountLarge > 1 Then Exit Sub
If Target.Address(0, 0) = "D9" Then
For Each Cl In Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp))
If Cl.Value = Target.Value Then
Set FndRw = Cl
Exit For
ElseIf Cl.Value > Target.Value Then
Set FndRw = Cl.Offset(-1)
Exit For
End If
Next Cl
If FndRw Is Nothing Then
Set FndRw = Sheet1.Range("A" & Rows.Count).End(xlUp)
End If
For i = 2 To 9
MySum = MySum + Cells(12, i).Value * FndRw(1, i).Value
Next i
Target.Offset(1).Value = MySum
End If
End Sub``````

#### Marc L

##### Excel Ninja
Yes as it's not VBA but VBAC : Visual Basic Algorithmic for Children !​
And when the child is not able to explain its homework, its notation is always near zero …​

#### Anbuselvam K

##### Member
Dear All

I need your valuable support, Almost I finished my code and struck with the last one thing as below

the highlighted code line is taking i = 85 to 136 column number in both sheets.

How do I write the code For i = 85 to 136 in Sheets("Master Data") and For i = 2 to 53 in sheets("RM Price")

Any another way to get the desired results.

Code:
``````Sub indexmatch()
Dim colu As Range, FndRow As Range
Dim High As Date
Dim i As Long
Dim Sum As Double

High = Range("EN1").Value
For Each colu In Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp))
If colu.Value = High Then
Set FndRow = colu
Exit For
ElseIf colu.Value > High Then
Set FndRow = colu.Offset(-1)
Exit For
End If
Next colu
If FndRow Is Nothing Then
Set FndRow = Sheet2.Range("A" & Rows.Count).End(xlUp)
End If
For i = 85 To 136
Sum = Sum + Cells(4, i).Value * FndRow(1, i).Value
Next i
Range("EN10") = Sum
End Sub``````

#### Anbuselvam K

##### Member
Can anyone help!

How do I write the code For i = 85 to 136 in Sheets("Master Data") and For i = 2 to 53 in sheets("RM Price")

#### Anbuselvam K

##### Member
Hi

I have added two codes here. The code1 is working well, But when I add the code1 into code2 it is showing type mismatch error in Line 92.

Please check the code and give me a solution.

Code1
Code:
``````Sub indexmatch()
Dim colu As Range, FndRow As Range
Dim High As Date
Dim i As Long
Dim Sum As Double

High = Range("EN1").Value
For Each colu In Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp))
If colu.Value = High Then
Set FndRow = colu
Exit For
ElseIf colu.Value > High Then
Set FndRow = colu.Offset(-1)
Exit For
End If
Next colu
If FndRow Is Nothing Then
Set FndRow = Sheet2.Range("A" & Rows.Count).End(xlUp)
End If
For J = 85 To 136
For i = 2 To 53
Sum = Sum + Cells(4, J).Value * FndRow(1, i).Value
Next i
Next
Range("EN10") = Sum / 52
End Sub``````
Code2
Code:
``````Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim J As Range, G As Range, Where As Range, Colu As Range, Fndrow As Range
Dim Low As Date, High As Date
Dim Dates, Types, Values
Dim i As Long
Dim Sum As Double, Sum1 As Double, Sum2 As Double

'Only if P1 changes
If Intersect(Target, Range("P1")) Is Nothing Then Exit Sub

'Get the dates
Low = Range("EO1").Value
High = Range("EN1").Value
'Refer to the used cells in column J
Set J = Range("J8", Range("J" & Rows.Count).End(xlUp))
'Same size in column G
Set G = Intersect(Columns("G"), J.EntireRow)
Dates = J.Value
Types = G.Value

Select Case Target.Value
Case Range("EN2").Value
'Same size in column CF
Set Where = Intersect(Columns("CF"), J.EntireRow)
Values = Where.Value
'Process the SUMPRODUCT
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next

Case Range("EN3").Value
Set Where = Intersect(Columns("T"), J.EntireRow)
Values = Where.Value
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next

Case Range("EN4").Value
Set Where = Intersect(Columns("B"), J.EntireRow)
Dates = Where.Value
Set Where = Intersect(Columns("CF"), J.EntireRow)
Values = Where.Value

For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum1 = Sum1 + Values(i, 1)
End If
Next

Set Where = Intersect(Columns("CA"), J.EntireRow)
Values = Where.Value
Dates = J.Value

For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum2 = Sum2 + Values(i, 1)
End If
Next
Sum = Sum1 - Sum2

Case Range("EN5").Value
Set Where = Intersect(Columns("BY"), J.EntireRow)
Values = Where.Value
'Process the SUMPRODUCT
For i = 1 To UBound(Dates)
If Dates(i, 1) >= Low And Dates(i, 1) <= High And Types(i, 1) = "Sales" Then
Sum = Sum + Values(i, 1)
End If
Next

Case Range("EN6").Value
For Each Colu In Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp))
If Colu.Value = High Then
Set Fndrow = Colu
Exit For
ElseIf Colu.Value > High Then
Set Fndrow = Colu.Offset(-1)
Exit For
End If
Next Colu
If Fndrow Is Nothing Then
Set Fndrow = Sheet2.Range("A" & Rows.Count).End(xlUp)
End If
For J = 85 To 136
For i = 2 To 53
Sum = Sum + Cells(4, i).Value * Fndrow(1, i).Value
Next i
Next
Sum = Sum / 52
Case Range("EN7").Value
Set Where = Intersect(Columns("B"), J.EntireRow)
Dates = Where.Value
Set Where = Intersect(Columns("CE"), J.EntireRow)
Values = Where.Value

For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum1 = Sum1 + Values(i, 1)
End If
Next

Set Where = Intersect(Columns("BZ"), J.EntireRow)
Values = Where.Value
Dates = J.Value

For i = 1 To UBound(Dates)
If Dates(i, 1) <= High Then
Sum2 = Sum2 + Values(i, 1)
End If
Next
Sum = Sum1 - Sum2
End Select

'Events off, otherwise we call ourself
Application.EnableEvents = False
'Write the sum into the sheet
Range("EL7") = Sum
'Events on
Application.EnableEvents = True
End Sub``````