Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Matching Two String with 2 Columns then copy dates and match in table

0

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
Answer
Discuss



Answer the Question

You must create an account to use the forum. Create an Account or Login