bartmanekul
Board Regular
- Joined
- Apr 3, 2017
- Messages
- 58
- Office Version
- 365
- Platform
- Windows
I've been using a VBA script which was kindly made by DMT32, but I just have a query around something additional it might be able to do with a small change.
It uploads data from a line into a table, and I've noticed that you can do it from another sheet in the same book to a different table - but the source data it moves still comes from sheet1.
Is there any way to easily adjust so that it uploads the data depending on what sheet your on? It'd be great to be able to upload different data to a different table in the same book.
It uploads data from a line into a table, and I've noticed that you can do it from another sheet in the same book to a different table - but the source data it moves still comes from sheet1.
Is there any way to easily adjust so that it uploads the data depending on what sheet your on? It'd be great to be able to upload different data to a different table in the same book.
Code:
Sub SaveTemplateData()
'dmt32 - May 2017
Dim DatabasePassword As String, TemplateSheet As String
Dim wbDatabase As Workbook, wbTemplate As Workbook
Dim DatabaseRange As Range, DataEntryRange As Range, Item As Range
Dim DatabaseName As Variant, msg As Variant, Data() As Variant
Dim i As Integer, InputCellCount As Integer
Dim CompleteAllCells As Boolean
'**********************************************************************************************
'*******************************************SETTINGS*******************************************
'Database workbook open password - enter as required (case sensitive)
DatabasePassword = ""
'Template Input Addresses
'cells can be both contiguous & non-contiguous
TemplateInputAddress = "B118:BM118"
'data entry rules (Set True if ALL Cells must be completed)
CompleteAllCells = False
'**********************************************************************************************
'Database Path / Name
DatabaseName = Cells(Rows.Count, 1).Value
If Len(DatabaseName) = 0 Then
DatabaseName = BrowseFile
If DatabaseName = False Then Exit Sub
Cells(Rows.Count, 1).Value = DatabaseName
End If
On Error GoTo myerror
'check file / folder path valid
If Not Dir(DatabaseName, vbDirectory) = vbNullString Then
Application.ScreenUpdating = False
Set wbTemplate = ThisWorkbook
'data entry range
Set DataEntryRange = wbTemplate.Worksheets(1).Range(TemplateInputAddress)
'count No Input Cells
InputCellCount = DataEntryRange.Cells.Count
For Each Item In DataEntryRange.Cells
'check if required entry for all cells
If CompleteAllCells And Len(Item.Value) = 0 Then
MsgBox "Please Complete All Fields.", 16, "Entry Required"
Item.Select
Exit Sub
End If
'build array
i = i + 1
ReDim Preserve Data(1 To i)
'data values to array
If IsDate(Item.Text) Then
Data(i) = DateValue(Item.Text)
Else
Data(i) = Item.Value
End If
Next Item
'or if some blank cells allowed, check if any data entered
If Not CompleteAllCells And Application.CountA(Range(TemplateInputAddress)) = 0 Then
MsgBox "All Fields Are Empty.", 16, "Error"
Exit Sub
End If
'Open database
Set wbDatabase = Workbooks.Open(DatabaseName, ReadOnly:=False, Password:=DatabasePassword)
'Next empty range in database
With wbDatabase.Sheets(1)
Set DatabaseRange = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
End With
'output array to database range
DatabaseRange.Resize(1, InputCellCount).Value = Data
'close & save
wbDatabase.Close True
'clear form
DataEntryRange.ClearContents
'report success
msg = Array("Template Data Saved", "Data Saved")
Else
'report problem
msg = Array(DatabaseName & Chr(10) & "File Not Found", "Error")
End If
myerror:
Application.ScreenUpdating = True
If Err > 0 Then
If Not wbDatabase Is Nothing Then wbDatabase.Close False
MsgBox (Error(Err)), 48, "Error"
Else
MsgBox msg(0), 48, msg(1)
End If
'clean up
Set wbDatabase = Nothing
Set wbTemplate = Nothing
Set DataEntryRange = Nothing
End Sub
Last edited: