User Form entry in a second sheet - need help with VBA code

**DocAElstein** · 02-16-2022, 04:06 PM

Hi Liviu
It’s possibly difficult for me to understand the full picture as I know nothing about UserForms.
I doubt therefore that I will be able to give you exactly the final coding you need, since I don’t understand the workings of UserForms.
Also, if I click that Form button , then I see this, which is impossible for me to see anything in.
https://i.postimg.cc/8cdDypfn/Click-Form-Button.jpg
ClickFormButton.JPG
( If you have an issue / problem specific to something associated with the UserForm then I can’t help further. If for example, there is a simple typo in Task, or you have task rather than Task, then I can’t see that in that UserForm )

The best I can do therefore is give again some ideas that takes the matching further and goes on to match those date values, and then puts the Amount in the appropriate place in database1
(Basically, what I did for you before is going some way to demo to you coding that does that sort of row matching based on the various criteria of matching headings. So that was just matching the rows, which matched effectively "Name" and "Project" and the "Task).

This next macro is basically the same as my last. But instead of the demo message box, it now adds the "Amount" value to be added to Database1 sheet in the corresponding cell

The way I have done this extra section, is to convert the Year and Month from column B and C in Database, (along with an assumed day of the first of the month) to an Excel date serial number *****
I then compare that with the date serial numbers for the top row of Database1.
A match will then tell me which column to put the Amount in

Code:

Sub MatchNameProjectTask3()
Rem 0 Worksheets info
Dim WsD As Worksheet, WsD1 As Worksheet
 Set WsD = ThisWorkbook.Worksheets("Database"): Set WsD1 = ThisWorkbook.Worksheets("Database1")
Dim LrD As Long, LrD1 As Long
 Let LrD = WsD.Range("A" & WsD.Rows.Count & "").End(xlUp).Row: Let LrD1 = WsD1.Range("A" & WsD1.Rows.Count & "").End(xlUp).Row
Rem 2 make arrays of concatenated words
Dim arrD() As String, arrD1() As String
 ReDim arrD(2 To LrD): ReDim arrD1(2 To LrD1)
Dim rwD As Long, rwD1 As Long
    For rwD = 2 To LrD
     Let arrD(rwD) = WsD.Range("D" & rwD & "") & WsD.Range("E" & rwD & "") & WsD.Range("F" & rwD & "")
    Next rwD
    For rwD1 = 2 To LrD1
     Let arrD1(rwD1) = WsD1.Range("A" & rwD1 & "") & WsD1.Range("B" & rwD1 & "") & WsD1.Range("C" & rwD1 & "")
    Next rwD1
'2b) Array of date serials from Database1
Dim arrDtSerials() As Variant, LcD1 As Long
 Let LcD1 = WsD1.Cells(1, WsD1.Columns.Count).End(xlToLeft).Column
 Let arrDtSerials() = WsD1.Range("A1").Resize(1, LcD1).Value2
Rem 3 compare arrays for headings
    For rwD = 2 To LrD
        For rwD1 = 2 To LrD1
            If arrD(rwD) = arrD1(rwD1) Then    '     MsgBox prompt:="match for " & arrD(rwD) & " at Database row " & rwD & " Database1 row " & rwD1
            '3b We have a heading match , so now match the date
            Dim DteSerial As Variant
            ' Let DteSerial = WsD.Evaluate("=DATEVALUE(""1 " & WsD.Range("C2").Value & " " & WsD.Range("B2").Value & """)")
             Let DteSerial = WsD.Evaluate("=DATEVALUE(""1 " & WsD.Range("C" & rwD & "").Value & " " & WsD.Range("B" & rwD & "").Value & """)")
            Dim MtchRes As Variant
             Let MtchRes = Application.match(DteSerial, arrDtSerials(), 0)
                If IsError(MtchRes) Then MsgBox prompt:="No date match": Exit Sub
             Let WsD1.Cells(rwD1, MtchRes) = WsD.Range("G" & rwD & "").Value
            Else
            
            End If
        Next rwD1
    Next rwD
End Sub

So this would be the Before, as we had before: https://excelfox.com/forum/showthrea...ll=1#post16377

Then, after running that macro, this would be the After https://excelfox.com/forum/showthrea...ll=1#post16378

Alan

*****Unfortunately dates in Excel and VBA are a real pain in the arse, since different excel versions and land versions and user setting all give different results, so you may need to tweak some of the coding that gets the date match. There is no known way around these problems. It makes sharing files to different people with dates in them sometimes impossible.
The macro is working in my Excel
Its based on this bit working to give me the correct date serial number from worksheet Database

Code:

Sub Dts()
Rem 0 Worksheets info
Dim WsD As Worksheet
 Set WsD = ThisWorkbook.Worksheets("Database")
Dim DteSerial As Variant
 Let DteSerial = Evaluate("=DATEVALUE(""1-January-2022"")") ' 44562 : Variant/Double
 Let DteSerial = WsD.Evaluate("=DATEVALUE(""1-"" & ""January"" & ""-2022"")") ' 44562 : Variant/Double
 Let DteSerial = WsD.Evaluate("=DATEVALUE(""1-" & WsD.Range("C2").Value & "-2022"")") ' 44562 : Variant/Double
 Let DteSerial = WsD.Evaluate("=DATEVALUE(""1-" & WsD.Range("C2").Value & "-2022"")") ' 44562 : Variant/Double
 Let DteSerial = WsD.Evaluate("=DATEVALUE(""1-" & WsD.Range("C2").Value & "-" & WsD.Range("B2").Value & """)")  ' 44562 : Variant/Double
 Let DteSerial = WsD.Evaluate("=DATEVALUE(""1 " & WsD.Range("C2").Value & " " & WsD.Range("B2").Value & """)") ' 44562 : Variant/Double
 
 
 
End Sub