Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Updating worksheet problem

Hi,

I am using the following code to create new worksheets from
pre-existing table. On updating, if there are existing spreadsheets
need a certain section of each spreadsheet to remain unchanged
A1:H12. How do i do this?


thanks,
Hamish



Option Explicit

Sub FilterCities()
Dim c As Range
Dim ws As Worksheet

'rebuild the CityList
Sheets("MAIN").Columns("H:H").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Sheets("CITIES").Range("A1"), _
Unique:=True
Sheets("CITIES").Range("A1").CurrentRegion.Sort _
Key1:=Sheets("CITIES").Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
'check for individual City worksheets
For Each c In Range("CityList")
If WksExists(c.Value) = False Then
Set ws = Sheets.Add
ws.Name = c.Value
ws.Move After:=Sheets(Sheets.Count)
' Sheets(Range("CityList").Cells(1, 1).Value) _
' .Rows("1:1").Copy Destination:=ws.Rows("1:1")
Else
Worksheets(c.Value).Cells.Clear
End If
'change the criteria in the Criteria range
Sheets("CITIES").Range("D2").Value = c.Value
'transfer data to individual City worksheets
Sheets("MAIN").Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CITIES").Range("D1:D2"), _
CopyToRange:=Sheets(c.Value).Range("A14"), _
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 Functio

--
Message posted from http://www.ExcelForum.com

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default Updating worksheet problem

Can you use column A to find the next open spot?

But this line clears out existing stuff on the "to" worksheet:

Worksheets(c.Value).Cells.Clear

I commented it out, but I'm not sure if you want to.

I think this came from Debra Dalgleish's site. Her routine throws away the
existing stuff and refreshes it with the data from the main sheet.

if you wanted to keep the 12 lines of headers, you could do:

worksheets(c.value).Rows("13:65536").Clear



Option Explicit
Sub FilterCities()

Dim c As Range
Dim ws As Worksheet
Dim DestCell As Range

'rebuild the CityList
Sheets("MAIN").Columns("H:H").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Sheets("CITIES").Range("A1"), _
Unique:=True

Sheets("CITIES").Range("A1").CurrentRegion.Sort _
Key1:=Sheets("CITIES").Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

'check for individual City worksheets
For Each c In Range("CityList")
If WksExists(c.Value) = False Then
Set ws = Sheets.Add
ws.Name = c.Value
ws.Move After:=Sheets(Sheets.Count)
' Sheets(Range("CityList").Cells(1, 1).Value) _
' .Rows("1:1").Copy Destination:=ws.Rows("1:1")
Else
' Worksheets(c.Value).Cells.Clear
End If

'change the criteria in the Criteria range
Sheets("CITIES").Range("D2").Value = c.Value

With Sheets(c.Value)
'put it in the next open cell in column A
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
If DestCell.Row < 13 Then
Set DestCell = .Cells(13, "A")
End If
End With

'transfer data to individual City worksheets
Sheets("MAIN").Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CITIES").Range("D1:D2"), _
CopyToRange:=DestCell, _
Unique:=False
Next
MsgBox "Data has been sent"
End Sub

HamishM wrote:

Hi,

I am using the following code to create new worksheets from a
pre-existing table. On updating, if there are existing spreadsheets i
need a certain section of each spreadsheet to remain unchanged -
A1:H12. How do i do this?

thanks,
Hamish

Option Explicit

Sub FilterCities()
Dim c As Range
Dim ws As Worksheet

'rebuild the CityList
Sheets("MAIN").Columns("H:H").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Sheets("CITIES").Range("A1"), _
Unique:=True
Sheets("CITIES").Range("A1").CurrentRegion.Sort _
Key1:=Sheets("CITIES").Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
'check for individual City worksheets
For Each c In Range("CityList")
If WksExists(c.Value) = False Then
Set ws = Sheets.Add
ws.Name = c.Value
ws.Move After:=Sheets(Sheets.Count)
' Sheets(Range("CityList").Cells(1, 1).Value) _
' .Rows("1:1").Copy Destination:=ws.Rows("1:1")
Else
Worksheets(c.Value).Cells.Clear
End If
'change the criteria in the Criteria range
Sheets("CITIES").Range("D2").Value = c.Value
'transfer data to individual City worksheets
Sheets("MAIN").Range("Database").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CITIES").Range("D1:D2"), _
CopyToRange:=Sheets(c.Value).Range("A14"), _
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

---
Message posted from http://www.ExcelForum.com/


--

Dave Peterson

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Updating worksheet problem

Thanks Dave - that works a treat.


---
Message posted from http://www.ExcelForum.com/

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
Automatic updating of a rollup worksheet when a new worksheet is a Marc A. Excel Worksheet Functions 1 August 7th 06 07:49 PM
updating one spreadsheet with another problem davidbev008 Excel Worksheet Functions 1 October 1st 05 02:50 AM
When updating a worksheet, how do I create a link updating the sa. Phlashh Excel Worksheet Functions 9 January 27th 05 06:05 PM
Updating database worksheet problem (Template Wizard) grasping@straws Excel Discussion (Misc queries) 1 December 17th 04 02:26 PM


All times are GMT +1. The time now is 07:45 AM.

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

About Us

"It's about Microsoft Excel"