Originally Posted by
anish.ms
Also, I need to have the option of loading the information back to the visit report from the database, which may be from a drop-down list. Let me try that out and will definitely have to come back to seek your help.
1. I made some improvements to the sub to copy to database
2. I'd check out double clicking a cell in a row on Database, and moving that data to the input form
Option Explicit
Sub Button_Click()
Dim wsVR As Worksheet
Dim loDB As ListObject
Dim arr As Variant
Dim n As Long
Set wsVR = ThisWorkbook.Worksheets("Visit Report")
Set loDB = ThisWorkbook.Worksheets("Database").ListObjects(1)
arr = Application.WorksheetFunction.Transpose(wsVR.Range("D4:D10"))
loDB.ListRows.Add.Range.Resize(1, UBound(arr, 1)).Value = arr
n = loDB.ListRows.Count
arr = Application.WorksheetFunction.Transpose(wsVR.Range("O13:O34"))
loDB.ListRows(n).Range.Cells(8).Resize(1, UBound(arr)).Value = arr
arr = Application.WorksheetFunction.Transpose(wsVR.Range("O36:O65"))
loDB.ListRows(n).Range.Cells(30).Resize(1, UBound(arr)).Value = arr
arr = Application.WorksheetFunction.Transpose(wsVR.Range("O67:O85"))
loDB.ListRows(n).Range.Cells(60).Resize(1, UBound(arr)).Value = arr
End Sub
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wsVR As Worksheet
Dim r As Range
Set r = Target.Cells(1, 1).EntireRow
If Len(r.Cells(1, 1).Value) = 0 Then Exit Sub
Set wsVR = ThisWorkbook.Worksheets("Visit Report")
r.Cells(1, 1).Resize(1, 7).Copy
wsVR.Range("D4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
r.Cells(1, 8).Resize(1, 22).Copy
wsVR.Range("O13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
r.Cells(1, 30).Resize(1, 30).Copy
wsVR.Range("O36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
r.Cells(1, 60).Resize(1, 19).Copy
wsVR.Range("O67").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
End Sub