Macro help need with worksheet unprotect/protect and closing an externally referenced file...

[Steve]

Hi,

I have the following macro that will shell out and open another
spreadsheet to bring some data back into my workbook. Somehow, I need
this macro to close that externally referenced file (without saving)
once it opens it, manipulates some data and copies it to bring back
into my workbook. Everything works now except the closing part.

The second part of my problem is that one of the sheets in this
workbook is protected because of a macro button I have on that sheet.
It's protected without a password. I need to get the protection to
temporarily be turned off to do some things and then turn itself back
on again.

Any help would certainly be appreciated...


Regards,

Steve


Sub Macro1()

' Macro1 Macro
' Macro recorded 6/5/2007 by Stephen Shockley
'

'

Application.ScreenUpdating = False

Dim myvalue As Variant
myvalue = Application.GetOpenFilename

Workbooks.Open Filename:=myvalue

Application.DisplayAlerts = False


' DOING SOME THINGS TO THE EXTERNALLY REFERENCED FILE

Cells.Select
Selection.Copy


Application.DisplayAlerts = True


Windows("Simplify Where-Used Report.xls"). _
Activate

Sheets("Where-Used Imported").Select

Range("A1").Select

ActiveSheet.Paste
Range("A1").Select

Sheets("Filter Out Blanks 1").Select

Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="X"
Range("B1:E40001").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Filter Out Blanks 2").Select
ActiveWindow.SmallScroll Down:=-3
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter Field:=5, Criteria1:="<>"

Range("A2:F2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:F2501").Select
Selection.Copy
Sheets("Simplified Where-Used").Select


' NEED TO UNPROTECT THE "Simplified Where-Used" NAMED SHEET HERE


Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select


' NEED TO RE-PROTECT THE "Simplified Where-Used" NAMED SHEET
HERE

Range("A1").Select
End Sub

 

[Dave Peterson]

One of the bad things about using the macro recorder is that it relies on your
actions and selections. So once I read that "Selection.PasteSpecial" line (with
no .select before it), I get lost.

But this may give you a different idea how to approach the problem:

Option Explicit
Sub Macro1()

Dim WkbkName As Variant
Dim Wkbk As Workbook
Dim SimplifiedWkbk As Workbook
Dim RngToCopy As Range

WkbkName = Application.GetOpenFilename(filefilter:="Excel files, *.xls")

If WkbkName = False Then
Exit Sub 'user hit cancel
End If

Application.ScreenUpdating = False

Set SimplifiedWkbk = Workbooks("Simplify Where-Used Report.xls")

Set Wkbk = Workbooks.Open(Filename:=WkbkName)

'use the first worksheet or the name???
With Wkbk.Worksheets(1) 'wkbk.worksheets("sheet9999")
Set RngToCopy = .Cells
End With

RngToCopy.Copy _
Destination:=SimplifiedWkbk.Worksheets("Where-Used
Imported").Range("a1")

With SimplifiedWkbk.Worksheets("Filter Out Blanks 1")
.AutoFilterMode = False
.UsedRange.Columns.AutoFilter Field:=1, Criteria1:="X"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'should anything be done?
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(2).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With

If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Filter Out Blanks 2")
.Range("C1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.AutoFilterMode = False
.UsedRange.Columns.AutoFilter Field:=5, Criteria1:="<>"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'do nothing again?
Set RngToCopy = Nothing
Else
'just the visible data
Set RngToCopy = .Resize(.Rows.Count - 1, 6).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With
End If

If RngToCopy Is Nothing Then
'do nothing
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
'your code is based on selection, so I don't know where to paste.
'more stuff here
End With
End If

End Sub

 

[Steve]

One of the bad things about using the macro recorder is that it relies on your
actions and selections. So once I read that "Selection.PasteSpecial" line (with
no .select before it), I get lost.

But this may give you a different idea how to approach the problem:

Option Explicit
Sub Macro1()

Dim WkbkName As Variant
Dim Wkbk As Workbook
Dim SimplifiedWkbk As Workbook
Dim RngToCopy As Range

WkbkName = Application.GetOpenFilename(filefilter:="Excel files, *.xls")

If WkbkName = False Then
Exit Sub 'user hit cancel
End If

Application.ScreenUpdating = False

Set SimplifiedWkbk = Workbooks("Simplify Where-Used Report.xls")

Set Wkbk = Workbooks.Open(Filename:=WkbkName)

'use the first worksheet or the name???
With Wkbk.Worksheets(1) 'wkbk.worksheets("sheet9999")
Set RngToCopy = .Cells
End With

RngToCopy.Copy _
Destination:=SimplifiedWkbk.Worksheets("Where-Used
Imported").Range("a1")

With SimplifiedWkbk.Worksheets("Filter Out Blanks 1")
.AutoFilterMode = False
.UsedRange.Columns.AutoFilter Field:=1, Criteria1:="X"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'should anything be done?
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(2).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With

If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Filter Out Blanks 2")
.Range("C1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.AutoFilterMode = False
.UsedRange.Columns.AutoFilter Field:=5, Criteria1:="<>"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'do nothing again?
Set RngToCopy = Nothing
Else
'just the visible data
Set RngToCopy = .Resize(.Rows.Count - 1, 6).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With
End If

If RngToCopy Is Nothing Then
'do nothing
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
'your code is based on selection, so I don't know where to paste.
'more stuff here
End With
End If

End Sub






















--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

Whilst I'm trying to follow what you've done, I'm still a novice at
VBA, basically as you could tell, most of what I put together is done
by using the recorder. I have a difficult time understanding all of
the If, Else, With and End With statements. I'll have another look at
this tomorrow, but not sure how far I will get.


Thanks,

Steve

 

[Dave Peterson]

Post back with any questions. I'm sure someone will respond.

 

[Steve]

Post back with any questions. I'm sure someone will respond.






--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hi,

I put another reply post up around noon eastern time today, but for
some reason it hasn't come up yet. Anyhow, I've managed to get what
you did for me to work to a degree and even inserted something to make
the called workbookclose when finished with it. Can you or anyone
else explain to me what it is in the macro that is making the first
filter go down 4000 rows and the second one go down 2500 rows. I
guess I'm not seeing it in the code, even though this is what it is
doing. I need to know this in the event that I need to extend it
further some day. I may have a few more questions before it's all
said and done, but this will do it for me until Monday.


Thanks,

Steve

 

[Dave Peterson]

If you let excel guess what range should be used for the autofilter (or sort or
subtotals or charts or...), it can guess wrong.

It may extend the range way past what you think is the last used row. If you
type something in X9999 and later delete that value, then excel still thinks
that the used range extends at least to x9999.

You have a couple of choices.

#1. Define the range that you want filtered explicitly--based on values in
certain columns or certain rows.

dim LastRow as long
dim Lastcol as long
with worksheets("sheet9999")
'based on column A
lastrow = .cells(.rows.count,"A").end(xlup).row
'based on row 1
lastcol = .cells(1,.columns.count).end(xltoleft).column

.range("A1",.cells(lastrow,lastcol).autofilter ......

end with

#2. You can try to reset what excel sees as the last used cell.

Debra Dalgleish shares some tips on how to reset this last used cell:
http://contextures.com/xlfaqApp.html#Unused

Note that sometimes, that lastcell just won't give in and be reset.

 

[Steve]

If you let excel guess what range should be used for the autofilter (or sort or
subtotals or charts or...), it can guess wrong.

It may extend the range way past what you think is the last used row. If you
type something in X9999 and later delete that value, then excel still thinks
that the used range extends at least to x9999.

You have a couple of choices.

#1. Define the range that you want filtered explicitly--based on values in
certain columns or certain rows.

dim LastRow as long
dim Lastcol as long
with worksheets("sheet9999")
'based on column A
lastrow = .cells(.rows.count,"A").end(xlup).row
'based on row 1
lastcol = .cells(1,.columns.count).end(xltoleft).column

.range("A1",.cells(lastrow,lastcol).autofilter ......

end with

#2. You can try to reset what excel sees as the last used cell.

Debra Dalgleish shares some tips on how to reset this last used cell:http://contextures.com/xlfaqApp.html#Unused

Note that sometimes, that lastcell just won't give in and be reset.







Steve wrote:




--

Dave Peterson- Hide quoted text -

- Show quoted text -

Hi Dave,

I've been fooling around with this for a few days now and am getting
something together that almost works. I've been tempted to post my
whole macro back up after I get it performing the way I want to see if
anyone would take a look at it like you did and show me how I can
clean it up.

Anyhow, I have this one part that I've inserted near the beginning of
my macro to delete some unused blank rows. However, I noticed that
what you had provided me with didn't actually activate or select the
worksheets or cells. The part below that I've inserted does actually
select a worksheet and some cells. How can I use this part of the
macro and be consistent with what you had already done for me?


Please advise,

Steve


With SimplifiedWkbk.Worksheets("Where-Used Imported")

.Range("D1").Delete Shift:=xlUp

Worksheets("Where-Used Imported").Select
Range("D").Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange

If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With

 

[Dave Peterson]

Maybe...

dim DummyRng as range 'used later
....


With SimplifiedWkbk.Worksheets("Where-Used Imported")
'did you want just D1 deleted or all of row 1
'.rows(1).delete ' would delete the whole row
.Range("D1").Delete Shift:=xlUp

On Error Resume Next
.Range("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
on error goto 0

set dummyrng = .UsedRange

If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With

 

[Steve]

Maybe...

dim DummyRng as range 'used later
....

With SimplifiedWkbk.Worksheets("Where-Used Imported")
'did you want just D1 deleted or all of row 1
'.rows(1).delete ' would delete the whole row
.Range("D1").Delete Shift:=xlUp

On Error Resume Next
.Range("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
on error goto 0

set dummyrng = .UsedRange

If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With













--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

OK, this post may appear twice. I posted around noon today and it
never showed up even though I got a message that said it was
successful. Who knows?

Thanks for the fix, however I have another problem now. When I try
and use this workbook now to call on another workbook for information
(same format), my macro won't copy the information and bring it back
into my original workbook. I've pasted the entire macro in below (yes
it is sloppy, but the best I can do).



Please help,

Steve




Sub Macro1()


Dim WkbkName As Variant
Dim Wkbk As Workbook
Dim SimplifiedWkbk As Workbook
Dim RngToCopy As Range


WkbkName = Application.GetOpenFilename(filefilter:="Excel files,
*.xls")


If WkbkName = False Then
Exit Sub 'user hit cancel
End If


Application.ScreenUpdating = False


Set SimplifiedWkbk = Workbooks("Simplify Where-Used Report.xls")


Set Wkbk = Workbooks.Open(Filename:=WkbkName)


'use the first worksheet or the name???
With Wkbk.Worksheets("sheet1")
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select

Cells.Select
Selection.RowHeight = 12.75
Rows("1:10").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Cells.Select

With Selection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Columns("C:S").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveSheet.DrawingObjects.Select
Selection.Delete
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)),
TrailingMinusNumbers:=True


Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Columns("A:A").Select
Selection.ColumnWidth = 5

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Columns("C:C").Select
Selection.ColumnWidth = 18
Columns("D").Select
Selection.ColumnWidth = 54


Set RngToCopy = .Cells
End With



RngToCopy.Copy _
Destination:=SimplifiedWkbk.Worksheets("Where-Used
Imported").Range("A1")


Dim DummyRng As Range 'used later



With SimplifiedWkbk.Worksheets("Where-Used Imported")
'did you want just D1 deleted or all of row 1
'.rows(1).delete ' would delete the whole row
.Range("D1").Delete Shift:=xlUp


On Error Resume Next
.Range("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0


Set DummyRng = .UsedRange


If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With




If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Where-Used Imported Clnd Up")
.Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End With
End If


With SimplifiedWkbk.Worksheets("Filter Out Blanks 1")
.AutoFilterMode = False
.UsedRange.Columns.AutoFilter Field:=1, Criteria1:="X"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'should anything be done?
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(2).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With


If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Filter Out Blanks 2")
.Range("C1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.AutoFilterMode = False
.UsedRange.Columns.AutoFilter Field:=5, Criteria1:="<>"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'do nothing again?
Set RngToCopy = Nothing
Else
'just the visible data
Set RngToCopy = .Resize(.Rows.Count - 1,
6).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With
End If


If RngToCopy Is Nothing Then
'do nothing
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("E1:F2000").Cut _
Destination:=SimplifiedWkbk.Worksheets("Simplified
Where-Used").Range("C1")


With SimplifiedWkbk.Worksheets("Simplified Where-
Used")
.Range("E1:F2000").Clear _

End With
End With
End With
End If




If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("a1:d2500").AdvancedFilter Action:=xlFilterInPlace,
_
CriteriaRange:=Worksheets("Simplified Where-
Used").Range("a1:d2500"), Unique:=True
.Range("_filterDataBase").Cells.SpecialCells(xlCellTypeVisible).Copy
_
Destination:=Worksheets("Dupl Removed Where-
Used").Range("a1")
With .Range("_filterDataBase")
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'do nothing again?
Set RngToCopy = Nothing
Else
'just the visible data
Set RngToCopy = .Resize(.Rows.Count - 1,
4).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With
End If

End Sub

 

[Dave Peterson]

I think you'll have to share more information--even better, narrow your posted
code to just the part that you're having trouble with.

I'm not sure what that part is, but you have a couple of things at the end that
could be cleaned up:

If RngToCopy Is Nothing Then
'do nothing
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("E1:F2000").Cut _
Destination:=.Range("C1")
.Range("E1:F2000").Clear
End With
End If


If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("a1:d2500").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("a1:d2500"), Unique:=True
.Range("_filterDataBase").Cells _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Dupl Removed Where-Used").Range("a1")
With .Range("_filterDataBase")
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'do nothing again?
Set RngToCopy = Nothing
Else
'just the visible data
Set RngToCopy = .Resize(.Rows.Count - 1, 4).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With
End If


But the biggest problem is that I don't see any .paste or .pastespecial after
that last section.

 

[Steve]

I think you'll have to share more information--even better, narrow your posted
code to just the part that you're having trouble with.

I'm not sure what that part is, but you have a couple of things at the end that
could be cleaned up:

If RngToCopy Is Nothing Then
'do nothing
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("E1:F2000").Cut _
Destination:=.Range("C1")
.Range("E1:F2000").Clear
End With
End If

If RngToCopy Is Nothing Then
'nothing to do
Else
RngToCopy.Copy
With SimplifiedWkbk.Worksheets("Simplified Where-Used")
.Range("a1:d2500").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("a1:d2500"), Unique:=True
.Range("_filterDataBase").Cells _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Dupl Removed Where-Used").Range("a1")
With .Range("_filterDataBase")
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible
'do nothing again?
Set RngToCopy = Nothing
Else
'just the visible data
Set RngToCopy = .Resize(.Rows.Count - 1, 4).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With
End With
End If

But the biggest problem is that I don't see any .paste or .pastespecial after
that last section.























...

read more »- Hide quoted text -

- Show quoted text -

Dave,

Thanks for your patience and bearing with me on this and point taken
about not posting the entire macro and trying to explain things
better. I'll try and do this a little better. I've incorporated your
changes at the end of the macro and everything seems to be working for
the initial workbook that I call up within the macro to manipulate and
the retrieve some data back into my original workbook. However, when
I try and use the macro to call up and retrieve data from a different
workbook, the data doesn't copy back into my original workbook. I can
see that it opens the called workbook and manipulates the data the way
I want it brought back in, but it doesn't get copied back into the
originating workbook. Here is what I have for the beginning of my
macro (hope it's not to long, but not sure how much you would need to
see...)

Please advise,

Steve

Sub Macro1()


Dim WkbkName As Variant
Dim Wkbk As Workbook
Dim SimplifiedWkbk As Workbook
Dim RngToCopy As Range

WkbkName = Application.GetOpenFilename(filefilter:="Excel files,
*.xls")

If WkbkName = False Then
Exit Sub 'user hit cancel
End If

Application.ScreenUpdating = False

Set SimplifiedWkbk = Workbooks("Simplify Where-Used Report10.xls")

Set Wkbk = Workbooks.Open(Filename:=WkbkName)

With Wkbk.Worksheets("sheet1") 'wkbk.worksheets("sheet9999")
Set RngToCopy = .Cells

'DOING SOME STUFF TO CALLED WORKBOOK WORKSHEET
'BEFORE I COPY DATA FOR DESTINATION WORKBOOK WORKSHEET

End With

RngToCopy.Copy _
Destination:=SimplifiedWkbk.Worksheets("Where-Used
Imported").Range("a1")

Dim DummyRng As Range 'used later

With SimplifiedWkbk.Worksheets("Where-Used Imported")
'did you want just D1 deleted or all of row 1
'.rows(1).delete ' would delete the whole row
.Range("D1").Delete Shift:=xlUp

On Error Resume Next
.Range("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

Set DummyRng = .UsedRange

If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With

 

[Dave Peterson]

Your code at the end does one of these:

Set RngToCopy = ....

But I don't see any place where you actually test to see if that range is
nothing.

And I don't see where you try to do any pasting.

 

[Steve]

Your code at the end does one of these:

Set RngToCopy = ....

But I don't see any place where you actually test to see if that range is
nothing.

And I don't see where you try to do any pasting.







Steve wrote:



















--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

O.K., I've made an attempt at making the adjustments you've suggested,
however, being the novice that I am, it may be wrong or overkill.
Anyhow, everything still seems to be working for the initial workbook
that I call up within the macro to manipulate and the retrieve some
data back into my original workbook. Again, when I try and use the
macro to call up and retrieve data from a different (larger) workbook,
the data doesn't copy back into my original workbook. I can see that
it opens the called workbook and manipulates the data the way I want
it brought back in, but it doesn't get copied back into the
originating workbook.

Therefore, I thought I would try something a little different. I
tried accessing a smaller file of different data to bring back into my
workbook and that seemed to work. Is there something that could be
causing this problem in the macro that won't allow the data to be
brought back in if the amount of data is to large?


Regards,

Steve

Here is what I have for the beginning of my macro after attempting
your latest suggestions:

Option Explicit
Sub Macro1()


Dim WkbkName As Variant
Dim Wkbk As Workbook
Dim SimplifiedWkbk As Workbook
Dim RngToCopy As Range


WkbkName = Application.GetOpenFilename(filefilter:="Excel files,
*.xls")


If WkbkName = False Then
Exit Sub 'user hit cancel
End If


Application.ScreenUpdating = False


Set SimplifiedWkbk = Workbooks("Simplify Where-Used Report20.xls")


Set Wkbk = Workbooks.Open(Filename:=WkbkName)



With Wkbk.Worksheets("sheet1") 'wkbk.worksheets("sheet9999")
Set RngToCopy = .Cells


End With


If RngToCopy Is Nothing Then
'do nothing
Else
With Wkbk.Worksheets("sheet1") 'wkbk.worksheets("sheet9999")

'DOING SOME STUFF TO CALLED WORKBOOK WORKSHEET
'BEFORE I COPY DATA FOR DESTINATION WORKBOOK WORKSHEET

Columns("A").Select
Selection.Copy

RngToCopy.Copy

RngToCopy.Copy _
Destination:=SimplifiedWkbk.Worksheets("Where-Used
Imported").Range("a1")

End With
End If


Dim DummyRng As Range 'used later

With SimplifiedWkbk.Worksheets("Where-Used Imported")
'did you want just D1 deleted or all of row 1
'.rows(1).delete ' would delete the whole row
.Range("D1").Delete Shift:=xlUp


On Error Resume Next
.Range("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0


Set DummyRng = .UsedRange


If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With

 

[Dave Peterson]

Again, your code doesn't include the final "End Sub" line. Maybe there's code
that you're not posting that does the work, but since you're not posting it, I
can't help.



Steve wrote:

 

[Steve]

Again, your code doesn't include the final "End Sub" line. Maybe there's code
that you're not posting that does the work, but since you're not posting it, I
can't help.

Steve wrote:

<snipped>



























--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

If you want me to go ahead and post the whole macro again, I can, but
I thought you wanted me to keep in as short as possible. Anyhow, I
know that this works with calling up smaller workbooks. I did play
around with the macros a bit and found that when I commented out the
part where the unused rows get deleted, the macro runs completely,
(but the blank rows don't get deleted). This is the part that I
commented out as explained above....

I'm guessing that on the larger called up workbooks theres something
that this part of the macro that the calling workbook can't handle...



Regards,

Steve

With SimplifiedWkbk.Worksheets("Where-Used Imported")
'did you want just D1 deleted or all of row 1
'.rows(1).delete ' would delete the whole row
.Range("D1").Delete Shift:=xlUp


' On Error Resume Next
' .Range("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' On Error GoTo 0


Set DummyRng = .UsedRange


If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If
End With

 

[Dave Peterson]

This part of the macro:

If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
Set RngToCopy = Nothing
Else
Set RngToCopy = .Columns(1).Resize(, 4) _
.Cells.SpecialCells(xlCellTypeVisible)
End If

Determines if what should be copied next.

There is no next portion.

if rngtocopy is nothing then
'do nothing
else
rngtocopy.copy
somethinggoesheresothatyoucanpastespecial
end if