Using VBA Code for a Data Entry Form

[UpToTheGills]

… because macOS excel ¯\_(ツ)_/¯

(Using Excel 2019 v.16.65 on macOS so no built-in Forms creation functionality.)

From googling, the alternative solution if you're on macOS is to use VBA code and I found this helpful webpage with example code so I'm attempting to adapt it for my own use case but I'm not familiar with VBA.

My use case is for a trade journal spreadsheet.
To use a data entry form on a worksheet (called Data Input ) to insert trades into the trade journal worksheet.

The data entry cells are the ones coloured green:

myCopy = "F5,F6,F8,F9,F11,F12,F13,F14,F16,F17,F18,F19,F20"

• F5 and F6 contain the formula =TODAY() to save input however if overwritten with a date other than the current day, I want the code to check cells F5 and F6 and reinsert the =TODAY() if necessary.
• The worksheet where the data is to be inserted is arranged with the latest data at the top rather than at the bottom whereby additional lines are inserted when needed. I need the code to check that there are free rows to insert the data, if not, to stop and show a warning OR ideally, to run one of the macros I have to insert new rows.
• One additional point is that although the date and time are separate on the Data Input worksheet, in the journal worksheet they are combined in a single cell.

This is as far as I've got with the code:

Sub UpdateTradeJournal()

    'some of these DIMs may either not be needed or incorrect or perhaps need additional ones?
    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    'cells to copy from Input sheet
    myCopy = "F5,F6,F8,F9,F11,F12,F13,F14,F16,F17,F18,F19,F20"

    Set inputWks = Worksheets("Data Input")
    Set historyWks = Worksheets("IC Live 4004xxxx")

    'haven't tried to amend any of the below code as yet
    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.Goto .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With

End Sub

I will use XL2BB to get a section of the journal worksheet posted up shortly.
Looking forward to learning something new and gratefully for any and all help received. Thanks in advance.

 

[UpToTheGills]

Re: 2. 4. I think I've figured out a way around it…

Add an additional

Dim myValidate As String

and

myCopy = "F5,F6,F8,F9,F11,F12,F13,F14,F16,F19,F20"

which omits the two cells that aren't mandatory to contain data so

    With inputWks
        Set myRng = .Range(myValidate)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With

should then work.

 

[UpToTheGills]

For 2. 5. need to adapt the macro that clears the form to include something like:

Check cells F5 & F6
If Has.Formula do nothing
ElseIf cells F5 & F6 .Value = "=TODAY()"

in proper VBA syntax.

 

[UpToTheGills]

Would the following work to clear all cells in the input worksheet that have constants in them then to check if the two cells that should have =TODAY() in them are blank and if they are, reinsert =TODAY() into them?

    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
         End With
   
    'check to see if formula needs to be reinserted into cells
        If Range("F5:F6").Value = IsEmpty Then Range("F5:F6").Value = "=TODAY()"
       
        Application.Goto .Cells(1) ', Scroll:=True
      On Error GoTo 0
    End With

 

[UpToTheGills]

Makes more sense to amend Application.Goto .Cells(1) to Application.Goto .Cells(8, 6), to make the active cell F8 after the form has been cleared, ready for next input.

 

[UpToTheGills]

OK, this is where I'm at with the code so far:

Sub UpdateTradeJournal()
'Code adapted from and thanks to: https://www.contextures.com/xlForm02.html

    Dim journalWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim reqCells As String
    Dim myCell As Range
   
    'all cells to copy from Data Input worksheet
    myCopy = "F5,F6,F8,F9,F11,F12,F13,F14,F16,F17,F18,F19,F20"
    'cells that require input
    reqCells = "F5,F6,F8,F9,F11,F12,F13,F14,F16,F19,F20"

    Set inputWks = Worksheets("Data Input")
    Set journalWks = Worksheets("IC Live 4004xxxx")

    'locating the next empty row on Journal spreadsheet
    With journalWks
        nextRow = .Cells(3, 2).End(xlDown).Offset(-1, 0).Row
    'need to add check to see if there is space and call macro to insert extra lines if not
    End With

    'check that all required cells are filled
    With inputWks
        Set myRng = .Range(reqCells)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Missing required information. Check your input!"
            Exit Sub
        End If
    End With

    'pasting info into Journal spreadsheet - this all needs checking / amending
    With journalWks
        oCol = 3
        For Each myCell In myRng.Cells
            journalWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
   
    'clear cells from Data Input that only contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
         End With
   
    'check to see if formula needs to be reinserted into the top two cells on the Input Data worksheet
        If Range("F5:F6").Value = IsEmpty Then Range("F5:F6").Value = "=TODAY()"
       
        Application.Goto .Cells(8, 6)
      On Error GoTo 0
    End With

End Sub

Remaining to do:

• when the check for the next empty row happens, if that happens to be Row 3 then I need to call the macro Sub Insert5Lines() instead
• the actual pasting of the data into the journal

 

[UpToTheGills]

    'locating the next empty row on Journal spreadsheet
    With journalWks
        nextRow = .Cells(3, 2).End(xlDown).Offset(-1, 0).Row
    'need to add check to see if there is space and call macro to insert extra lines if not
    If ActiveCell.Address = "$B$3" Then
    Call Insert5Lines()
    End If
    End With

Hopefully that will work for the first bullet point in the post above, if anyone feels like casting their eye over it, I would be most grateful.
Noticed that I need an End If for the final IF statement too...

 

[UpToTheGills]

Last piece of the macro to solve...

    'pasting info into Journal spreadsheet - this all needs checking / amending
    With journalWks
        oCol = 3
        For Each myCell In myRng.Cells
            journalWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With

The issue here is that where I want the info pasted isn't a contiguous series of cells on the same row.
I'm not sure how to overcome that. I don't really want to rearrange data on the journal worksheet to make it contiguous.

Any help appreciated.

Realise I need to amend the oCol value to 2 as the first data needs to be pasted into the cell in column B.
Am guessing there is some way to specify pasting the first two cells values into columns B & C, skip two columns and continue pasting in from column F?

Have also realised that I need to

Set myRng = .Range(myCopy)

but have already

Set myRng = .Range(reqCells)

earlier in the code, can can you change what you Set something in VBA?