Replacing sheet causes #REF

H

Homer

What I have:

A sheet that is named all containing 40 columns of information. Every day
or two new information is added to the next row. Column 40 contains the
names Bill, Joe, Ted, Frank, Steve.

I have a macro that will take each name and make a separate sheet for each.
The macro will delete the old name. The names don't change, nor do their
spelling. The only things that will change are new rows are added and a new
name may be added.

In a cell, I use sum to add up a specific column from each sheet.
=SUM(Ted!Q2:Q161)

What happens is that when I run the macro to replace the sheets, I get
=SUM(#REF!Q2:Q161)

I assume that because the spelling of the sheet name doesn't change the
formula should work. I assume wrong. Any suggestions?
 
S

Shane Devenshire

Hi,

1. You should show us the code
2. Why do you "replace" the sheets when the names never change, only new
ones get added?
 
D

Dave Peterson

You have a couple of choices (at least).

#1. Instead of deleting the existing worksheet, just clear all the cells.

Dim testwks as worksheet
set testwks = nothing
on error resume next
set testwks = worksheets("Bill")
on error goto 0

if testwks is nothing then
'your code to add it
else
testwks.cells.clear
end if

....

#2. Change the formulas that refer to cells on these worksheets to strings,
delete the worksheet, add the worksheet, and change the strings back to
formulas.

Dim FormWks as worksheet
dim NewWks as worksheet

'if you have more than one sheet with formulas that refer to "Bill", you'll
'have to do this a few times...
set formwks = worksheets("Formulasheetnamehere")

formwks.cells.Replace what:="=", replacement:="$$$$$=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

on error resume next
application.displayalerts = false
worksheets("Bill").delete
application.displayalerts = true
on error goto 0

set newwks = worksheets.add
newwks.name = "Bill"

formwks.cells.Replace what:="$$$$$=", replacement:="=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

========
Both untested, uncompiled. Watch for typos.
 
H

Homer

Dave,

I would like to use option 1 and not delete the worksheets every time I
updated the information on the summary page, named All. I would like to
update the summary page and have the other sheets in the workbook update
based on the contents of the cells in column AN.

Here is the code I use now. It is a mixture from a few people, you have
helped on portions back in January.

Sub Copy_Row_To_Other_Sheets()
' This sub uses the functions LastRow and SheetExists
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim DestRange As Range
Dim FieldNum As Integer
Dim Lr As Long

'Name of the sheet with your data
Set ws1 = Sheets("All") '<<< Change

'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = ws1.Range("A1:An" & Rows.Count)

'Set Field number of the filter column
'This example filters on the first field in the range(change the field
if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column
B, ......
FieldNum = 40

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

' Add a worksheet to copy the a unique list and add the CriteriaRange
Set ws2 = Worksheets.Add

With ws2
'first we copy the Unique data from the filter field to ws2
rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

'loop through the unique list in ws2 and filter/copy to a worksheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)

If Trim(cell.Value) = "" Then
'skip it
Else
'do all the work
End If

On Error Resume Next
Application.DisplayAlerts = False
Worksheets(cell.Value).Delete
Application.DisplayAlerts = True

On Error GoTo 0

Set WSNew = Sheets.Add

On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0

Set DestRange = WSNew.Range("A1")

'Firstly, remove the AutoFilter
ws1.AutoFilterMode = False

'Filter the range
rng.AutoFilter Field:=FieldNum, Criteria1:="=" & cell.Value

'Copy the visible data and use PasteSpecial to paste to the
worksheet
ws1.AutoFilter.Range.Copy
With DestRange
.Parent.Select
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
' Delete the header row if you copy to a existing worksheet
If Lr > 0 Then WSNew.Range("A" & Lr + 1).EntireRow.Delete

'Close AutoFilter
ws1.AutoFilterMode = False

Lr = 0
Next cell

'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0

End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub



Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function


Is there a way to copy the information from sheet All to other sheets in the
workbook? If I can do this, it should solve my original question because the
sheet names will stay put.
 
D

Dave Peterson

This portion will have to change:

With ws2
'first we copy the Unique data from the filter field to ws2
rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

'loop through the unique list in ws2 and filter/copy to a worksheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)

If Trim(cell.Value) = "" Then
'skip it
Else
'do all the work
End If

On Error Resume Next
Application.DisplayAlerts = False
Worksheets(cell.Value).Delete
Application.DisplayAlerts = True

On Error GoTo 0

Set WSNew = Sheets.Add

On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0

Set DestRange = WSNew.Range("A1")

To something like:


With ws2
'first we copy the Unique data from the filter field to ws2
rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

'loop through the unique list in ws2 and filter/copy to a worksheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)

Set WSNew = Nothing
On Error Resume Next
Set WSNew = Worksheets(cell.Value)
On Error GoTo 0

If WSNew Is Nothing Then
'it's not there, so add it
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
Else
'it's already there, so clear the cells
WSNew.Cells.Clear
End If

Set DestRange = WSNew.Range("A1")

==================
This is untested and uncompiled. Watch for typos.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top