Modify The VB Code

[adam]

Hi Anyone,

I’m using the following VB code in a workbook in excel 2007 having which has two sheets.

When I enter the fields "D3,D8,H8,H9,H12,H13,J9,J12,J13,J26,J8,F8" to Sheet1 (which I have named as “NewMemo”) and click the macro, the entered fields are saved to the first empty row of the sheet2 (which is named as “Memos”).

But this VB code has a part that it inserts the machine username in column B of the “Memos Sheet”. It is as follows

Code: Select all

With MemosWks
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

I have tried a couple of ways to get rid of that part so that I could insert my range form beging the column B.

I would be pleased if you could modify the code so that this machine username will not appear in the column B and I could enter my range from Column B and the date on column A

Thanks in advance.

The whole code is as follows

Code: Select all

Sub UpdateLogWorksheet()
Application.ScreenUpdating = False

    Dim MemosWks As Worksheet
    Dim NewMemoWks 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 NewMemo sheet - some contain formulas
    myCopy = "D3,D8,H8,H9,H12,H13,J9,J12,J13,J26,J8,F8"

    Set NewMemoWks = Worksheets("NewMemo")
    Set MemosWks = Worksheets("Memos")

    With MemosWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With NewMemoWks
        Set myRng = .Range(myCopy)

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

With MemosWks
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 NewMemoWks
      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

[HansV]

I'd delete or comment out the line

.Cells(nextRow, "B").Value = Application.UserName

and change the line

oCol = 3

to

oCol = 2

(Column 1 = A, 2 = B, 3 = C etc.)

[adam]

How could I make this code to enter date to column “C” and Time to column “D” as data is entered to the column 5 of the worksheet?

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
With MemosWks
    With .Cells(nextRow, "A")
      .Value = Now
      .NumberFormat = "hh:mm:ss"
    End With
    oCol = 2
    For Each myCell In myRng.Cells
      MemosWks.Cells(nextRow, oCol).Value = myCell.Value
      oCol = oCol + 1
    Next myCell
  End With
End Sub

[HansV]

Where are nextRow and myRng defined?

[adam]

Sorry about the nextRow and myRng lines.

Instead , how could I make the code to omit those lines and put date in column “C” and Time in column “D” as data is entered to the column 5 of the worksheet?

[HansV]

So you want us to rewrite the code from scratch?

[adam]

Nevermind. Ill try to figure out the code for myself.