#1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 468
Default Adjust macro

Hi, i need the below macro to work even if in sheet1 i insert a row at the
top. Now, the datas begin from row 1. I need this macro to work if the data
start from row 2, and row 1 is empty.

Macro:
Sub ExtractReps()

Application.ScreenUpdating = False

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim NextRow

Set ws1 = Sheets("Sheet1")
Set rng = Range("Database1")

'extract a list of Sales Reps
ws1.Columns("F:F").Copy _
Destination:=Range("P1")
ws1.Columns("P:P").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("N1"), Unique:=True
r = Cells(Rows.Count, "N").End(xlUp).Row

'set up Criteria Area
Range("P1").Value = Range("F1").Value

For Each c In Range("N2:N" & r)
'add the rep name to the criteria area
ws1.Range("P2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then

Set ws2 = Sheets(c.Value)
Else

Set ws2 = Sheets.Add
End If

With ws2

.Move After:=Worksheets(Worksheets.Count)
.Name = c.Value

If .Range("A1").Value = "" Then

NextRow = 1
ElseIf .Range("A2").Value = "" Then

NextRow = 2
Else

NextRow = .Range("A1").End(xlDown).Row + 1
End If
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("P1:P2"), _
CopyToRange:=.Cells(NextRow, "A"), _
Unique:=False
End With

'start autofit all sheets
Cells.Select
Selection.ColumnWidth = 8.57
Cells.EntireColumn.autofit
Range("A1").Select
'end autofit all sheets


Next



ws1.Select
ws1.Columns("N:P").Delete

Application.ScreenUpdating = True

End Sub

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

Can this be done?
Thanks!
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
macro adjust Mylan Excel Worksheet Functions 1 November 18th 09 04:11 AM
to adjust download officegirl Excel Discussion (Misc queries) 1 April 7th 09 04:36 PM
How do I adjust a curve ? Mauro Charts and Charting in Excel 12 June 15th 07 06:35 PM
cells don't adjust boraguru Excel Discussion (Misc queries) 2 September 7th 05 03:11 PM
cells don't adjust boraguru Excel Discussion (Misc queries) 0 September 7th 05 01:05 AM


All times are GMT +1. The time now is 10:50 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"