Help with Ron de Bruin Script
 

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

Help with Ron de Bruin Script
 

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



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Kris" wrote in message oups.com...
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

Help with Ron de Bruin Script
 

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.

Help with Ron de Bruin Script
 

Read it this weekend Kris

Bedtime for me now

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Kris" wrote in message oups.com...
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.

Help with Ron de Bruin Script
 

I see two different code examples from my site

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.)

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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" wrote in message ...
Read it this weekend Kris

Bedtime for me now

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Kris" wrote in message oups.com...
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.