PDA

View Full Version : excel database



crazysved
03-09-2011, 09:53 PM
hello, I have created some sheets where the user can input a large range of data. I want to make a save button that will save the data by the date, checking if the date and the designated cells have already been saved in the database, prompting to overwrite or otherwise write the data to the next empty row in the database.
what I've done already and this may not be the best way please tell me if there is a better way(maybe ranges) but I've created another sheet (CashOutDB) that has lots of columns, I've given titles for each type of data I want to save in row 1 and in row 2 I've created a link to that cell on the worksheet where the data was entered.
when the user hits the save button on the main data entry sheet it should take all the data from the row2 I created on the CashOutDB and save it to another sheet called DB. I've tried using bits of code from here and there but I can't get it to work properly. i have this bit of code that has been saving the data from CashOutDB sheet to DB sheet but it is not saving to the next row or checking if the data is already there to overwrite. I've only kept 4 columns in this example.


Option Explicit
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = Worksheets("DB")
Set ws2 = Worksheets("CashOutDB")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'copy the data to the database
ws.Cells(iRow, 1).Value = ws2.Cells(iRow, 1).Value
ws.Cells(iRow, 2).Value = ws2.Cells(iRow, 2).Value
ws.Cells(iRow, 3).Value = ws2.Cells(iRow, 3).Value
ws.Cells(iRow, 4).Value = ws2.Cells(iRow, 4).Value
End Sub


can anyone please point me in the right direction or help me out with my code! thank you very much for your time.

Bob Phillips
03-10-2011, 02:18 AM
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rng As Range

Set ws = Worksheets("DB")
Set ws2 = Worksheets("CashOutDB")

'check if data already there
On Error Resume Next
'find date
Set rng = ws.Columns(1).Find(ws2.Range("A2").Value, LookIn:=xlFormulas)
On Error GoTo 0
If Not rng Is Nothing Then

iRow = rng.Row
If ws2.Range("B2").Value = ws.Cells(iRow, "B").Value And _
ws2.Range("C2").Value = ws.Cells(iRow, "C").Value And _
ws2.Range("D2").Value = ws.Cells(iRow, "D").Value Then

MsgBox "Duplicate"
Exit Sub
End If
End If

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
'copy the data to the database
ws2.Range("A2").Resize(, 4).Copy ws.Cells(iRow + 1, 1)
End Sub

crazysved
03-10-2011, 04:29 PM
Thank you for your reply xld! this got the data saving to the next row. there is still an issue I hope you can help me with. it seems that the code is copying the formula from the CashOUtDb to the Db and not the raw text data. I will be fixing the code up later but when the user hits the save button I will have the data on the data entry sheet reset to empty cells allowing the user to continue cashing out different people. each will have their own database to get around the duplicate dates for each person. my question then would be can we get the data from the one sheet and not the formula to transfer over? thank you so much for your time! I've been stuck on this for a while now :)