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

[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/showthrea...ll=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

[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