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

**DocAElstein** · 02-18-2022, 11:49 PM

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.

Code:

        ' 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....290229#p290229 https://eileenslounge.com/viewtopic....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

Code:

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

Code:

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** · 02-19-2022, 12:05 AM

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