Help with Ron de Bruin Script

[Kris]

I found this awesome macro on Ron de Bruin's site
(http://www.rondebruin.nl) that has let me copy a range from a closed
workbook on a shared drive. However when I encouter blank cells they
show us as 0 which throws off my other macros. No matter what I do to
change the function it still shows up with 0's.

Here is the code.

Sub GetRange(FilePath As String, FileName As String, SheetName As
String, _
SourceRange As String, DestRange As Range)

Dim Start

'Go to the destination range
Application.Goto DestRange

'Resize the DestRange to the same size as the SourceRange
Set DestRange = DestRange.Resize(Range(SourceRange).Rows.Count, _
Range(SourceRange).Columns.Count)

'Add formula links to the closed file
With DestRange
.FormulaArray = "='" & FilePath & "/[" & FileName & "]" &
SheetName _
& "'!" & SourceRange

'Wait
Start = Timer
Do While Timer < Start + 2
DoEvents
Loop

'Make values from the formulas
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
True, Transpose:=False
.Cells(1).Select
Application.CutCopyMode = False
End With
End Sub

Sub File_In_Network_Folder()
Application.ScreenUpdating = False
On Error Resume Next

'Call the macro GetRange
GetRange "\\dfw2nap01\global\SPECIAL\Bess", "abetest1.xls",
"Solution Direct Tracking", "A:AA", _
Sheets("Solution Direct Tracking").Range("A1")

On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

Hi Kris

You can add a replace line in the macro
Site is : http://www.rondebruin.nl/copy7.htm


Sub GetRange(FilePath As String, FileName As String, SheetName As String, _
SourceRange As String, DestRange As Range)

Dim Start

'Go to the destination range
Application.Goto DestRange

'Resize the DestRange to the same size as the SourceRange
Set DestRange = DestRange.Resize(Range(SourceRange).Rows.Count, _
Range(SourceRange).Columns.Count)

'Add formula links to the closed file
With DestRange
.FormulaArray = "='" & FilePath & "/[" & FileName & "]" & SheetName _
& "'!" & SourceRange

'Wait
Start = Timer
Do While Timer < Start + 2
DoEvents
Loop

'Make values from the formulas
.Copy
.PasteSpecial xlPasteValues
.Cells(1).Select
Application.CutCopyMode = False

.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End With
End Sub

 

[Kris]

Thanks for the answer Ron. This solution just crahses the workbook
because the entire worksheet where there is no value is displayed as a
zero. If there is a way I can get this sorting script to just ignore
ignore the cells with 0 in it (well just in the column I have specified
to sort by.)

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

With ws1
rng.Columns(10).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = Left(cell.Value, Len(cell.Value) - 2) &
Format(Val(Right(cell.Value, 2)) + 1, "00")
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With

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


Thanks for all of the help.

 

[Ron de Bruin]

Read it this weekend Kris

Bedtime for me now

 

[Ron de Bruin]

I see two different code examples from my site

If you have a zero in that column you can delete the sheet with 0 that is created ?