I have three below codes one is Filterandmatch match the two strings "BluWorld" in Column CT and "SANP" in Column CY when these both values matches then it copies the dates from Column DJ.
There is second Code MatchValueinTable which match these dates into table (I copy the single date manually from above code and paste into second code string that is dte because i do not know how to create loop) and return the value.
There is last code Three where i paste the second code return value in string lastvalue which matches the string in Sheet3 Column E and F if macthes then copy the value of Column J and paste it in Sheet1 DP3
I want is That first code will get first date and second code will return a value from date then third code will take that value and return one more values that will be pasted into Sheet1 DP3 to Downward according to dates.
I have added a sheet. I will truly appreciate your help.
Sub Filterandmatch()
Dim noRows As Long
Dim myRange As String
With Worksheets("Sheet1")
noRows = .UsedRange.Rows.Count
myRange = "CT2:DU" & noRows
.Range(myRange).AutoFilter Field:=1, Criteria1:="BluWorld"
.Range(myRange).AutoFilter Field:=6, Criteria1:="SANP"
.Range("DJ3", .Range("DJ" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet1").Range("N2")
End With
End Sub
Second Code
Sub MatchValueinTable()
Dim dte As Date
Dim Tblval As String
Dim lngR As Long
dte = ("4/26/2021") 'get the date from first code
dte = DateSerial(Year(dte), Month(dte), 1)
lngR = Worksheets("Sheet2").Range("A:A").Find(What:=Format(dte, "yyyy-mmm"), LookAt:=xlWhole, LookIn:=xlValues).Row
Tblval = Worksheets("Sheet2").Cells(lngR, Int((Day(dte) + 6) / 7) + 2).Value
Debug.Print Tblval
End Sub
Third Code
Sub Matchbetweenandcopy()
Dim lastvalue As Double, sh As Worksheet, lastR As Long, arr, arrFin, i As Long
lastvalue = 2.83
Set sh = Worksheets("Sheet3")
lastR = sh.Range("J" & sh.Rows.Count).End(xlUp).Row
arr = sh.Range("E7:J" & lastR).Value
ReDim arrFin(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) < lastvalue And arr(i, 2) > lastvalue Then arrFin(i, 1) = arr(i, 6)
Next i
Worksheets("Sheet1").Range("DP3").Resize(UBound(arrFin), 1).Value = arrFin
End Sub