PDA

View Full Version : A simple database project



Zentek
10-17-2008, 07:12 PM
Hi,

I haven't done any Excel VBA in years, and I must say this forum and some of the previous posts have been extremely helpful in building a big database for my work.
Unfortunately, I am now stuck and no matter how I rebuild my coding, I can't get it to do what I want.
In the first worksheet of my project, named DATA, I enter the data that needs to be classified. Every other worksheet has a two letter name (AB, BT, RO and such), and if this name can be found in column I of a row in DATA, I would like that row to move to the first empty row (columns A to H) in the matching worksheet.
It's simpler than I make it sound, but I hope it makes sense. Here's the code I tried building up to now:

Option Explicit
Sub SortData()
Dim sht As Worksheet
Dim OpsIni As Range, cell As Range

Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(sht) + 1

Set OpsIni = Range("I:I")

For Each cell In OpsIni

With Sheet1.Range("I:I")
If cell.Value = "AB" Then
Set sourceRange = Sheets("DATA").Cells(ActiveCell.Row, 1).Range("A1:H1")
With sourceRange
Set destrange = sht.Range("A" & Lr).Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

End If
End With
On Error GoTo 0
Next
End Sub

Function LastRow(sh As Worksheet) 'trouve la premiere rang?e vide
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


The sad thing is I already built this function 3 months ago and it worked (although it was more than twice the length), but the computer was formatted before I could implement it.

Thanks for your time and patience.

Demosthine
10-17-2008, 09:01 PM
Good Evening there.

I wanted to get some slight clarification from you before I get to working on a solution and I'll give you an idea of which direction I'd take.

From the sounds of it, as you mention a "large database," I feel safe assuming that your Worksheet is set up like the equivalent of an Access Table. Each Column will have a Column Header and the Data Type in each Column will be matching. (i.e. Column A is all Text, Column B is all Integer, etc.)

Are you wanting to clear the Destination Worksheets prior to copying all of your new data, or is this a running addition? That will only affect one line of code in my example, but it will make a difference.


That being said, I would use a Recordset Object and Query the Worksheet just as if it was an Access Table. Amazingly, you can do this within Excel. From your VBE, add a reference to 'Microsoft ActiveX Data Objects Recordset X.0 Library'

From here, much of the coding is done similar to Access or SQL. You'll create a Recordset Object, specify a Data Source (The UsedRange in Worksheet "DATA"), and then Query the Table.

The key to making this virtually seemless is the Range Object's CopyFromRecordset method. This will take all of the data from the Recordset Query and insert it into a Range of your choice.

I've attached a copy of a very simplistic example of the process I've listed above. You may have to re-reference the Recordset Library because I have Visual Studio 2008 and the newest .Net Installation, so I may have a newer version than you do. I've ran across several others I've mentioned this method to that have Version 3.0 or 4.0.


Let me know if this helps and if you need anything additional.
Scott

Zentek
10-20-2008, 08:25 PM
Hi,

Thank you for your quick reply.

Yes, this is a large database, where every column contains text.

Yes, it is a running addition (so no deleting or clearing is necessary), but if I was to clear the DATA worksheet, newer entries should still move to their correct worksheet destination, in the first free row.

We're running Excel 2003 here. I am not familiar with the method you are describing and I do not have Visual Studio, but I will try your way and let you know if I run into trouble.

Thank you again for your help.

Demosthine
10-20-2008, 09:34 PM
Good Evening.

Fortunately, VS2008 is not necessary for my method. It just means (most likely) that you will have a lower version of the ActiveX Data Objects Recordset. In another post, the other person had Version 2.8 and it worked fine.

With the larger database, this method would definitely be benificial.

Let me know how things work.
Scott

Zentek
10-24-2008, 07:17 PM
Hi Scott,

I tried working with what you sent, but unfortunately I don't have the skills and experience to modify this formula. From what I understood of it, it makes individual queries for every possible factor you want to count. This would be rather heavy and would require regular modifying in my case, because the two letters found in column I are employee initials. Simply put, I need to look up what is in column I and move the whole line to the first free row in the worksheet by the same name.

I tried different methods for looking up worksheet names or making it a variable, because if we get a new employee or someone leaves the company we won't need to edit the code, but simply add or remove one worksheet.

Thank you once again for your help, it is greatly appreciated

Demosthine
10-26-2008, 11:46 AM
Good Morning.

I'm sorry, I posted the wrong version of Query Results. I modified one that will work for what you want.

In this method, there are two RecordSet Queries. The first Queries the Data and creates a list of unique "Tax Level", which would equate to your Employee Initials. Using this Query, it cycles through and re-queries all of the Data limiting it to only those with that Records with the specifyc Initials.

If a Worksheet with that name alread exists, it will simply copy all of the selected Data to the appropriate Worksheet. If it does not exist, it will create the Worksheet and then copy the Data.

What the example does not do is delete Worksheets for anyone who has left the company and no longer has Data.

Hope this helps.
Scott

P.S. If I get the chance I'll re-post the workbook with a better explanation of what it does. I'll comment the code fairly well.

Zentek
10-29-2008, 07:37 PM
Hi Scott,

I am probably running an older version of Excel here. I'm getting an error on "Dim rstWorksheets As RecordSet" (Can't find project or library). RecordSet is not an option in my coding. I'm trying other alternatives, like Range, but when it gets to "Set rstWorksheets = New Range", it tells me (Invalid use of new Keyword).

Thanks again for all the time you've invested in this. This coding is way beyond anything I learned in college, but this is a great learning experience.

rbrhodes
10-30-2008, 12:22 AM
Hi ZenTek,

I may be reading this wrong but it sound to me like:

- you enter raw data in Sheet "Data", Cols A to H

- you enter a two letter code in Column I

- the row (Cols A - H) should be _copied_ to the sheet with the 2 letter name in Col I

This sub does that based on Sheet("Data") Column I changing.

It needs a lot more in the way of errorhandling, etc. (eg sheet not found...) but is it the correct interpretation?

Try this in a COPY of your workbook:

-right click the "Data" sheet tab
-Paste this in and close the VBE
- Change stuff in Cols A-H, and then enter a 2 letter code in Column I.

This should copy Cols A-H from the Data sheet to the sheet with the 2 letter code you put in Col I of "Data".


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CopyRow As Long
Dim LastRow As Long
Dim Destsheet As Worksheet
On Error GoTo endo
'If Column I changed
If Not Intersect(Target, Range("I:I")) Is Nothing Then
'Get sheet name from Column I contents & create object
Set Destsheet = Sheets(Target.Value)
'Get row to copy
CopyRow = Target.Row
With Destsheet
'Get Last row of destination sheet from Column A <===change to suit
LastRow = .Range("A65536").End(xlUp).Row + 1
'Copy to row 1 if blank sheet or lastrow + 1 if not
If .Cells(LastRow - 1, 1) = "" Then
LastRow = 1
End If
'Copy changed row to destination sheet first blank row
Range("A" & CopyRow & ":H" & CopyRow).Copy .Cells(LastRow, 1)
End With
End If
endo:
'Kill marching ants
Application.CutCopyMode = False
'Destroy object
Set Destsheet = Nothing
End Sub

Demosthine
10-30-2008, 05:05 PM
Hey Zentek.

Sorry it took me so long to get back to you. I've been heavily involved in another project.

The Recordset Object is not a default Reference or one that is native to Excel. To enable it, go to the Tools menu and then References... Scroll down until you find Microsoft ActiveX Data Objects x.x and select it. Click OK and then the code should run beautifully.

I'd note that if you are wanting it to copy the data once the Row is completely entered, Rhodes' idea would be better suited for that. As he says, it needs a some error checking (are all the mandatory cells completed, is it a valid sheet name having no special characters, does the sheet exist, etc.).

If you want to do it in a batch macro (like once a week), I'll help you finesse the Recordset method.

Take care.
Scott