Filter VBA Help!

  • Thread starter Thread starter ferrogy
  • Start date Start date
F

ferrogy

First off I am just learning VBA.
The code below is in a module for a workbook. What it does
is send each individual row
of my database to it's own worksheet.(creates one if none
exsist).
The problem is that it replaces the old data that is on
the worksheets with the new data
every time it is run.(ie. I never have more than the
header and ONE row of data)
What I need it to do is add a new row of data every time
the macro is run.
I have tried adding the paste special code that I got from
this page....
http://www.rondebruin.nl/copy1.htm ...but could not get
it to work.
The last row code must only apply to the sheets I am
sending the data to.
Thanks in advance for any help!

Option Explicit

Sub FilterCities()
Dim c As Range
Dim ws As Worksheet
For Each c In Range("STOCKLIST")
If WksExists(c.Value) = False Then
Set ws = Sheets.Add
ws.Name = c.Value
ws.Move After:=Sheets(Sheets.Count)
Sheets(Range("STOCKLIST").Cells(1, 1).Value) _
.Rows("1:1").Copy Destination:=ws.Rows("1:1")
End If
Sheets("CRIT").Range("D2").Value = c.Value
Sheets("DATA").Range("DATABASE").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRIT").Range("D1:D2"), _
CopyToRange:=Sheets(c.Value).Range("A1:H1"), _
Unique:=False
Next
MsgBox "Data has been sent"
End Sub


Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
 
Ferrogy,

........
........
End If

Worksheets(c.Value).Rows(2).Insert
'inserts a new row above row 2
'existing data (if any) moved down by 1 row
'Insert your new data into row 2
'Your data will be listed with the latest at the top
'If this isn't what you want, after inserting the new data, do a sort.

Sheets("CRIT").Range("D2").Value = c.Value
Sheets("DATA").Range("DATABASE").AdvancedFilter _
etc

HTH
Henry
 
For one thing, you cant use

worksheets(c.Value) as far as I know.

(e-mail address removed)
 
What gave you that idea? The previous poster in this thread says he used
it. Have you tried it?

Alan Beban
 
Henry,
I inserted the code and it is still just
writing over the row of data that is there.
Any ideas?
 
ferrogy,

Did you change the line that inserts the data into the new WSheet so that it
inserts it into Row 2, and not Row 1?

CopyToRange:=Sheets(c.Value).Range("A2:H2"), Unique:=False

HTH
Henry
 
ferrogy,

Is ALL the data being transferred or is some missing?
If all the data is transferred, the program is trying to transfer blank rows
as well as data.

If not all the data is being transferred, check to see how many rows the
data occupies.

Say it's 3 rows of data at a time then, change
Worksheets(c.Value).Rows(2).Insert
to
Worksheets(c.Value).Rows("2:4").Insert
'Inserts rows 2, 3, & 4

and

CopyToRange:=Sheets(c.Value).Range("A2:H2"), Unique:=False
to
CopyToRange:=Sheets(c.Value).Range("A2:H4"), Unique:=False

HTH
Henry
 
The code is great.
What I need is for it to do is create and copy to
sheets named as the value in cells A1 thur A50.
From my little knowledge it looks like these lines
would have to be changed.
a)firstcell = Sheets("Input").Cells(1, 1).Value
b)Set sourceRange = Sheets("Input").Rows("1:1")
(there might be others)
I have tried to change it to what I want but no
luck.Will try again later this evening.Wife has me
doing home improvements most of today.
Any ideas are greatly appreciated.
-----Original Message-----
Hi

Here a example to copy(values) row 1 of the input sheet
Click to expand...
to a sheet named as the value in cell A1
 
First thing I saw on you new code was this;Before I even tried the code I went an looked this up.
It did not take me long to realize that this is exactly
what was needed here.I then went and Google Group searched
it.Found a couple of your old post with it in use.Finally
was lead to McRitchie's site and found a wealth
information. A very good learning experience. Who knows at
this rate I might get good at this in five or ten years :)
Your help is GREATLY appreciated. Thank You.
 
Back
Top