steads1980
02-20-2011, 02:52 AM
:banghead: :helpI am trying to amend the attached spreadsheet so the code will copy more than 4 columns of data from the row from the data table onto the front form. I can't find the code I need to amend. Can anyone help?
Option Explicit
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myCopy As Range
Dim myTest As Range
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 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
myCopy.Copy
.Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
Sub UpdateLogRecord()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim lRec As Long
Dim oCol As Long
Dim lRecRow As Long
Dim myCopy As Range
Dim myTest As Range
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry")
lRec = inputWks.Range("CurrRec").Value
lRecRow = lRec + 1
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(lRecRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(lRecRow, "B").Value = Application.UserName
oCol = 3
myCopy.Copy
.Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
Option Explicit
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myCopy As Range
Dim myTest As Range
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 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
myCopy.Copy
.Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
Sub UpdateLogRecord()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim lRec As Long
Dim oCol As Long
Dim lRecRow As Long
Dim myCopy As Range
Dim myTest As Range
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry")
lRec = inputWks.Range("CurrRec").Value
lRecRow = lRec + 1
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(lRecRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(lRecRow, "B").Value = Application.UserName
oCol = 3
myCopy.Copy
.Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub