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

[Atlantis764]

Hi all,

I'm trying to use a form to add data to 2 sheets (Database and Database1).
In the first sheet (Database) each entry is added as a new line and everything is working fine.
The problem is when I try to add the data in the second sheet because I have to to match 3 criteria (name, project and task) and I don't know how to write the exact code for that.
I have used a code from a previous version of that form where only 2 criteria were matched (name and project).
In the Database1 sheet I filled with colors the cells where the values from the Database sheet must be entered.
I am attaching the work file.
Thanks in advance! Any help would be appreciated!

I have posted the same thread here
https://www.mrexcel.com/board/threads/user-form-entry-in-a-second-sheet-need-help-with-vba-code.1196175/




https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

Hello Atlantis764
Welcome to ExcelFox

I don’t have any experience with UserForms
and
I don’t really understand the full picture of what you are trying to do.

Here is a screenshot of the file you uploaded: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16365&viewfull=1#post16365

I can see that there is some correlation in the coloured cells, but all I can understand from your explanation is that you want to match Name and Project and Task as you showed in the workbook

The best I can do is that I can get you started on doing that matching:

We can make an array which has as many elements as there are data rows in Database1
Each element will contain a string made up from each row of the
Name & Project & Task

We can do something similar for worksheet Database

Then you can match the strings in the two arrays.

Run this demo macro and I think you will see what I mean



' https://excelfox.com/forum/showthread.php/2783-User-Form-entry-in-a-second-sheet-need-help-with-VBA-code?p=16371&viewfull=1#post16371
Sub MatchNameProjectTask()
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 v: v = WsD.Evaluate("=D2:D4&E2:E4&F2:F4"): v = WsD.Evaluate("=D2:D" & LrD & "&E2:E" & LrD & "&F2:F" & LrD & "")
Dim arrD() As Variant: Let arrD() = WsD.Evaluate("=D2:D" & LrD & "&E2:E" & LrD & "&F2:F" & LrD & "")
Dim arrD1() As Variant: Let arrD1() = WsD1.Evaluate("=A2:A" & LrD1 & "&B2:B" & LrD1 & "&C2:C" & LrD1 & "")
Rem 3 compare arrays
Dim rwD As Long, rwD1 As Long
For rwD = 2 To LrD
For rwD1 = 2 To LrD1
If arrD(rwD - 1, 1) = arrD1(rwD1 - 1, 1) Then MsgBox prompt:="match for " & arrD(rwD - 1, 1) & " at Database row " & rwD & " Database1 row " & rwD1

Next rwD1
Next rwD
End Sub


Here's the same basic macro done slightly differently

Sub MatchNameProjectTask2()
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
Rem 3 compare arrays
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
Next rwD1
Next rwD
End Sub

Alan



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Atlantis764]

Hi Alan,

thanks for the code but it doesn't do what I need to do.
I am trying to explain the full picture of my file:
1. I have a User form in sheet1 where I am adding new records.
2. When I save (or submit) the form all the data are added to Database sheet as a new line (this is working just fine with the bellow code)



Sub Submit_Data()

Dim sh As Worksheet
Dim sh1 As Worksheet
Dim iRow As Long, colno As Integer, iCol As Long, rowno As Integer
Dim iRow1 As Long, colno1 As Integer, iCol1 As Integer, reqdRow As Integer
Set sh = ThisWorkbook.Sheets("Database")
Set sh1 = ThisWorkbook.Sheets("Database1")
iRow = [Counta(Database!A:A)] + 1
iCol = Sheets("Database").Cells(1, Columns.Count).End(xlToLeft).Column - 1
iRow1 = [Counta(Database1!A:A)] + 1
iCol1 = Sheets("Database1").Cells(1, Columns.Count).End(xlToLeft).Column - 1

Application.ScreenUpdating = False
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = UserFormTest.CmbYear.Value
.Cells(iRow, 3) = UserFormTest.CmbMonth.Value
.Cells(iRow, 4) = UserFormTest.CmbName.Value
.Cells(iRow, 5) = UserFormTest.CmbProject.Value
.Cells(iRow, 6) = UserFormTest.CmbTask.Value
.Cells(iRow, 7) = UserFormTest.TxtAmount.Value
.Cells(iRow, 8) = Application.UserName
End With


3. At the same time as before (save or submit the form) I need that only the "Amount" value to be added to Database1 sheet in the corresponding cell
Ex. the amount of 100 from Database sheet (first record) must be added to cell "D15" (with yellow in Database1 sheet) because that cell is the corresponding cell for "Year 2022" "Month January" "Name bbb" "Project2" "Task2"



With sh1
For rowno = 2 To iRow1
If .Cells(rowno, 1) = UserFormTest.CmbName.Value And .Cells(rowno, 2) = UserFormTest.CmbProject.Value Then
reqdRow = rowno
Exit For
End If
Next
For colno = 4 To iCol1
If UserFormTest.CmbMonth.Value = Format(.Cells(1, colno), "MMMM") And _
UserFormTest.CmbYear.Value = Format(.Cells(1, colno), "YYYY") Then
.Cells(reqdRow, colno) = UserFormTest.TxtAmount.Value
End If
Next
.Cells(iRow, iCol1 + 3) = Application.UserName
End With

Call Reset

Application.ScreenUpdating = True
MsgBox "Date incarcate cu succes!"

End Sub


The above code is matching the "Name" and "Project" but not the "Task" and this is where I need your help.

Thanks again!
Liviu

[DocAElstein]

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
3833
( 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


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/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16377&viewfull=1#post16377

Then, after running that macro, this would be the After https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16378&viewfull=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



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



Ref http://www.eileenslounge.com/viewtopic.php?p=290229#p290229
https://excelfox.com/forum/showthread.php/2772-Some-Date-Notes-and-Tests

[Atlantis764]

Hi Alan,

thanks for your reply!
Please excuse my late answer.
I am really stuck at this point because I don't know where to add the code sent by you and I don't know the reason but I can't download the file sent by you.
Could you please attach the modified file again?

Thanks!

[DocAElstein]

Hi
I am not sure what hte problem is with the download for you. Once in a while something wont download on a particular operating system or Browser. We never figured out why yet.
I just put it in a share place for you, perhaps that will work for you
Share ‘Work_file.xlsm’ https://app.box.com/s/v9ifgeicp6nzha0axcha3qcprzgprgob

It's difficult for me to help further beacuse
_1 I can't see anything on the userform - as i showed in the screen shot the text and numbers are too small to see,
_ 2 I still really don't know what should happen.I don't understand what you want, where data comes from etc. etc... - You have given a pefectly good explanation for yourself or anyone else maybe who knows already the sort of thing that you are doing.
But you are talking to a complee stranger that knows VBA quite well but has no idea of your work. (and hasn't done much with userforms either - I do understand the very basics of them). I expect it would take me 10 seconds to sort your problem out , but a day first before I figured out what it is that should happen.
You will always improve your chances of an answer here, or elsewhere, if you give a very detailed walkthrough of what should happen , giving sample data and saying exactly what steps you do, where the data is coming from etc. etc
I feel your pain. You have an annoying problem and want the answer quick. Sometimes you strike lucky, and find someone that has done almost excactly what you are doing and sees at a glance what the problem is.
I hav'nt, so I can't

Alan

[Atlantis764]

Hi Alan,

I will try to explain exactly what should happen with my file:
1. when I click on "Form" button located in sheet1 a user form open and I enter all the data in this form (file attached in .jpg for you to see)
2. I fill all the data in this form (there are some dropdown lists-except the Amount) for each field. The fields from user form are exactly the headers from column B to G located in Database sheet (Year, Month, Name, Project, Task, Amount)-see File1.jpg attached.
3. When I click "SAVE" all the data are automatically added in Database sheet as a new line (less columns A and H that are auto filled) - please see File2.jpg attached.
This is done by the following code and it is working just fine


Sub Submit_Data()

Dim sh As Worksheet
Dim sh1 As Worksheet
Dim iRow As Long, colno As Integer, iCol As Long, rowno As Integer
Dim iRow1 As Long, colno1 As Integer, iCol1 As Integer, reqdRow As Integer
Set sh = ThisWorkbook.Sheets("Database")
Set sh1 = ThisWorkbook.Sheets("Database1")
iRow = [Counta(Database!A:A)] + 1
iCol = Sheets("Database").Cells(1, Columns.Count).End(xlToLeft).Column - 1
iRow1 = [Counta(Database1!A:A)] + 1
iCol1 = Sheets("Database1").Cells(1, Columns.Count).End(xlToLeft).Column - 1

Application.ScreenUpdating = False
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = UserFormTest.CmbYear.Value
.Cells(iRow, 3) = UserFormTest.CmbMonth.Value
.Cells(iRow, 4) = UserFormTest.CmbName.Value
.Cells(iRow, 5) = UserFormTest.CmbProject.Value
.Cells(iRow, 6) = UserFormTest.CmbTask.Value
.Cells(iRow, 7) = UserFormTest.TxtAmount.Value
.Cells(iRow, 8) = Application.UserName
End With



Call Reset

Application.ScreenUpdating = True

MsgBox "Date incarcate cu succes!"

End Sub


4. Now comes the part where I need help. I would like that when I click the "SAVE" button in my user form to add a new line in Database sheet as pct. 3 above (this is already working as described before) AND to add only the amount of 1000 to cell G20 from Database1 sheet (please see File3.jpg attached). That cell is the correspondent cell for the data that I filled in user form - Year 2022, Month April, Name bbb, Project Project5, Task Task2 as File1.jpg.

Hope it make sense now.
Thanks again!
P.S. The link sent before for downloading the file was great but the issue with the amount from Database1 sheet didn't worked

[DocAElstein]

Hi
OK, that’s all a bit clearer for me, thanks.
I probably could have a go… But …

I am still having problems doing anything with your UserForm.
I tried on three different computers, with Excel versions 2007, 2010 and 2013(professional)

So, I press the Form Button

This happens:
Excel 2007 text is too small to do anything with, as before ( that I did before was on another computer which also had Excel 2007 )
https://i.postimg.cc/wtxp8cXt/Click-Form-Button-2007.jpg (https://postimg.cc/wtxp8cXt)


Excel 2010 error
https://i.postimg.cc/w1QpGbm8/Error-opening-form-2010.jpg (https://postimg.cc/w1QpGbm8)

Excel 2013 ( Professional ) error
https://i.postimg.cc/t1rHXZkB/Error-opening-form-2013.jpg (https://postimg.cc/t1rHXZkB)


Translating those error texts in the last two screenshots to English – it says something about not being able to set ColumnWidth property due to type mismatch




If nobody else helps you in the meantime, I will try and take a look again later today when I have more time. I might be able to do something in Excel 2007, but its going to be very difficult for me to try and add data in the UserForm as I can barely see anything.

Its very strange that I get those errors in newer Excel versions. Also the small size I see, could suggest, along with the errors in newer versions, that something is dodgy with your userform


What Excel version are you using?


Perhaps in the meantime you could take a look and see if you can do something with the UserForm. Maybe make something bigger , at least just temporarily. Maybe if you make the Form and / or the text bigger and upload some other files with a modified UserForm size in, then I might have a better chance of seeing something in it.
And/ or see if you can figure out why I can't get the UserForm to come up in some of my Excels.
As I mentined, I do not have much experience with UserForms, but I have made a few. So far, when they work, they work in all my Excel versions. So I think there is at least a chance that something is a bit wonky in your UserForm, something that just by chance allows it work, all be it with very small text, in Excel 2007.
Could be a totally other explanation. I am just geussing due to my lack of a lot of experience with UserForms

I will try and look again today. It might have to wait until tomorrow.
Please if you get it fixed in the meantime, let me know, so I don’t waste my time.

Thanks
Alan

[Atlantis764]

Hi Alan,

I don't really know why you have those errors.
I am using Excel 2016
I have just modified the user form as per you suggestions and I'm attaching the new file.

Thanks again,
Liviu

[DocAElstein]

Hi Liviu

OK, I done it for you. ( It was not really solving a problem in your coding. There was no coding anywhere that made any attempt to put data into worksheet Database1 )
I have basically added / incorporated coding of the form I had in Sub MatchNameProjectTask3() into your macro to do the extra filling of Database1
So your initial explanation in post #1 was a bit misleading.
No matter
Here is the solution(s)


Some minor issues first
_ The userFormtext size is very good now. But the Form size was a bit big and bloated. But I fiddled around a bit (blindly) in the UserForm properties and in Private Sub UserForm_Initialize(). So that’s good enough for me to work with
_ I figured out that strange error as well in the .ColumnWidths : I am mostly using German Excel and my list separator is sometimes taken as ; rather than a ,
I did a quick bodge to get over that, but you might want to put that back to as you had it.

' Quick dodge to get over problem of different seperators in different land Office versions
On Error Resume Next
.LstDatabase.ColumnWidths = "40;50;60;60;60;60;60;30"
.LstDatabase.ColumnWidths = "40,50,60,60,60,60,60,30"
On Error GoTo 0
If iRow > 1 Then
It is usually better to do this sort of thing withput error handling, but I did not know how to easilly determine the seperator used by any Excel. I might be able later to do something along the lines that I did here: https://eileenslounge.com/viewtopic.php?p=290229#p290229 https://eileenslounge.com/viewtopic.php?p=267466#p267466
Possibly someone else passing this Thread knows of a simpler way.? I wpuld be very intersted and grateful of any imput


So on now to the main stuff…

This is approximately the macro you uploaded which need the additions

Dim sh As Worksheet
Dim sh1 As Worksheet
Dim iRow As Long, colno As Integer, iCol As Long, rowno As Integer
Dim iRow1 As Long, colno1 As Integer, iCol1 As Integer, reqdRow As Integer
Set sh = ThisWorkbook.Sheets("Database")
Set sh1 = ThisWorkbook.Sheets("Database1")
iRow = [Counta(Database!A:A)] + 1
iCol = Sheets("Database").Cells(1, Columns.Count).End(xlToLeft).Column - 1
iRow1 = [Counta(Database1!A:A)] + 1
iCol1 = Sheets("Database1").Cells(1, Columns.Count).End(xlToLeft).Column - 1
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = UserFormTest.CmbYear.Value
.Cells(iRow, 3) = UserFormTest.CmbMonth.Value
.Cells(iRow, 4) = UserFormTest.CmbName.Value
.Cells(iRow, 5) = UserFormTest.CmbProject.Value
.Cells(iRow, 6) = UserFormTest.CmbTask.Value
.Cells(iRow, 7) = UserFormTest.TxtAmount.Value
.Cells(iRow, 8) = Application.UserName
End With
Call Reset
MsgBox "Date incarcate cu succes!"
End Sub




This next is that macro with the addition. The additions are based on my last macro Sub MatchNameProjectTask3()


Sub Submit_Data()
Dim Wsh As Worksheet
Dim Wsh1 As Worksheet
Dim iRow As Long, colno As Integer, iCol As Long, rowno As Integer
Dim iRow1 As Long, colno1 As Integer, iCol1 As Integer, reqdRow As Integer
Set Wsh = ThisWorkbook.Sheets("Database"): Wsh.Select
Set Wsh1 = ThisWorkbook.Sheets("Database1")
iRow = [Counta(Database!A:A)] + 1
'Dim LrD As Long: Let LrD = iRow - 1
iCol = Sheets("Database").Cells(1, Columns.Count).End(xlToLeft).Column - 1
iRow1 = [Counta(Database1!A:A)] + 1
iCol1 = Sheets("Database1").Cells(1, Columns.Count).End(xlToLeft).Column - 1
With Wsh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = UserFormTest.CmbYear.Value ' Year
.Cells(iRow, 3) = UserFormTest.CmbMonth.Value ' Month
.Cells(iRow, 4) = UserFormTest.CmbName.Value ' Name
.Cells(iRow, 5) = UserFormTest.CmbProject.Value ' Project
.Cells(iRow, 6) = UserFormTest.CmbTask.Value ' Task
.Cells(iRow, 7) = UserFormTest.TxtAmount.Value ' Amount
.Cells(iRow, 8) = Application.UserName ' Submit
End With
' the bit to put Amount on Database1
Rem 2a match Name and Project and Task
With UserFormTest
Dim Kee As String: Let Kee = .CmbName.Value & .CmbProject.Value & .CmbTask.Value
End With
Dim LrD1 As Long: Let LrD1 = Wsh1.Range("A" & Wsh1.Rows.Count & "").End(xlUp).Row
Dim arrD1() As String: ReDim arrD1(2 To LrD1)
Dim rwD1 As Long
For rwD1 = 2 To LrD1
Let arrD1(rwD1) = Wsh1.Range("A" & rwD1 & "") & Wsh1.Range("B" & rwD1 & "") & Wsh1.Range("C" & rwD1 & "")
Next rwD1
'2b) Array of date serials from Database1
Dim arrDtSerials() As Variant, LcD1 As Long
Let LcD1 = Wsh1.Cells(1, Wsh1.Columns.Count).End(xlToLeft).Column
Let arrDtSerials() = Wsh1.Range("A1").Resize(1, LcD1).Value2
Rem 3 compare arrays for headings
For rwD1 = 2 To LrD1
If Kee = arrD1(rwD1) Then ' MsgBox prompt:="match for " & Kee & " at 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 = Wsh.Evaluate("=DATEVALUE(""1 " & Wsh.Range("C" & rwD & "").Value & " " & WsD.Range("B" & rwD & "").Value & """)")
Let DteSerial = Wsh.Evaluate("=DATEVALUE(""1 " & Wsh.Range("C" & iRow & "").Value & " " & Wsh.Range("B" & iRow & "").Value & """)")
Dim MtchRes As Variant
Let MtchRes = Application.match(DteSerial, arrDtSerials(), 0)
If IsError(MtchRes) Then MsgBox prompt:="No date match": Exit Sub
'Let Wsh1.Cells(rwD1, MtchRes) = WsD.Range("G" & rwD & "").Value
Wsh1.Activate
Let Wsh1.Cells(rwD1, MtchRes) = Wsh.Range("G" & iRow & "").Value
Else

End If
Next rwD1
Call Reset
MsgBox "Date incarcate cu succes!"
End Sub




The uploaded file, Work_file_modifiedBefore.xlsm is approximately your original uploaded (modified ) file.
, and Work_file_modifiedAfter.xlsm, is that same file with the modified macro


If anything is not quite right, then let me know and I will take another look. but you will have to wait a few days

Alan





Files at share site, incase you can’t get them from the upload again:
Share ‘Work_file_modifiedBefore.xlsm’ https://app.box.com/s/szruzgnhmccgwm3v9o8iafz9s29p182a
Share ‘Work_file_modifiedAfter.xlsm’ https://app.box.com/s/wigzth8u6khlwpqmtqj5eb1u6gqpwc2z

[Atlantis764]

Hi Alan,

thank you very much for all your great work!
The file sent by you "modifiedAfter" is working perfectly!
This is exactly what I wanted to achieve.
Sorry I gave you a hard time understanding what I was trying to achieve.

Many thanks,
Liviu

[DocAElstein]

Your welcome, thanks for the feedback
It is always very difficult to explain to someone else in enough detail for them to understand. It is also very difficult if you do not speak the English language.
But a good detailed walkthrough explanation will always make it easier for you to get help.

Alan


( P.S. Another thing that may help you get help in the future:
It is some times courteous to tell the people at mrexcel.com (https://www.mrexcel.com/board/threads/user-form-entry-in-a-second-sheet-need-help-with-vba-code.1196175/#post-5835818) that you have a solution, and tell them where you got it. That would help anyone seeing that Thread in the future at mrexcel.com (https://www.mrexcel.com/board/threads/user-form-entry-in-a-second-sheet-need-help-with-vba-code.1196175/#post-5835818) that is looking for a similar solution.
Being courteous like that may also help you to get help from mrexcel.com in the future.
But that is not too important)