Work Through a Database and Copy unique Values Q

[John]

I've got the following database details in a sheet called Database3, that
shows employee numbers and dates that they have clocked in

Col A Col B

1 11/04/05
1 12/04/05
1 13/04/05
2 12/04/05
2 14/04/05
3 11/04/05

I'm looking for a piece of code that will copy only the employee number to a
ceratin cell in worksheet "reports". I therefore need the code to work
through the detail above and everytime it finds a "new" employee number to
copy this 12 cells below where the first cell was copied in "Reports C11".
Thus what I would expect to see within the Reports worksheet in the
appropriate cells would be

C11 = 1
C23 = 2
C35 = 3

It would finally get to the end of the database at then just stop

Hope someone can assist

Thanks

 

[Debra Dalgleish]

You could filter the data to another sheet, then insert blank rows. The
following code takes data from sheet1 and moves the numbers to sheet2:

'===========================
Sub EmployeeNumbers()
Dim lRow As Long
Dim lLastRow As Long
Dim rng As Range
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")

Sheets("Sheet1").Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws2.Range("A1"), Unique:=True

lLastRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Range(ws2.Cells(2, 1), ws2.Cells(lLastRow, 1))
lRow = 2

For lRow = lLastRow To 2 Step -1
ws2.Range(ws2.Cells(lRow, 1), ws2.Cells(lRow + 10,
1)).EntireRow.Insert Shift:=xlDown
Next lRow

ws2.Range(ws2.Cells(1, 1), ws2.Cells(2, 1)).Delete Shift:=xlUp

End Sub
'==========================

 

[John]

Thanks Debra, that will work

You could filter the data to another sheet, then insert blank rows. The
following code takes data from sheet1 and moves the numbers to sheet2:

'===========================
Sub EmployeeNumbers()
Dim lRow As Long
Dim lLastRow As Long
Dim rng As Range
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")

Sheets("Sheet1").Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws2.Range("A1"), Unique:=True

lLastRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Range(ws2.Cells(2, 1), ws2.Cells(lLastRow, 1))
lRow = 2

For lRow = lLastRow To 2 Step -1
ws2.Range(ws2.Cells(lRow, 1), ws2.Cells(lRow + 10,
1)).EntireRow.Insert Shift:=xlDown
Next lRow

ws2.Range(ws2.Cells(1, 1), ws2.Cells(2, 1)).Delete Shift:=xlUp

End Sub
'==========================

 

[John]

I thought that would work Debra, problem being is that my worksheet 2 has a
defined layout, so I can't insert rows in it. I could I suppose just use a
simple =Ref in the appropriate cells.

 

[Debra Dalgleish]

Thange this section, so it doesn't insert an entire row:

'===========
For lRow = lLastRow To 2 Step -1
ws2.Range(ws2.Cells(lRow, 1), ws2.Cells(lRow + 10, 1)) _
.Insert Shift:=xlDown
Next lRow
'==============

 

[John]

Thanks Debra

I've tried the =Ref path but problem with inserting on sheet2 is that the
relatives still carry through on the source sheet, thus even holding the
cell references on Sheet1 doesn't work

Think I need something that will just filter with unique values and then
just use a =Ref, without the insertio of rows

 

[Debra Dalgleish]

You didn't mention the =Ref in your first message. What are you trying
to link to?

 

[John]

Debra

Did a workaround, just copied - paste special values the filtered values
into the range I required. Not sure if its efficient code but it works

Thanks

Thanks Debra

I've tried the =Ref path but problem with inserting on sheet2 is that the
relatives still carry through on the source sheet, thus even holding the
cell references on Sheet1 doesn't work

Think I need something that will just filter with unique values and then
just use a =Ref, without the insertio of rows