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