Speeding-up a macro

[Billy C]

Is there another way to re-write this VB to speed this
portion of my macro up?



Dim cell As Range
Dim rng As Range

On Error Resume Next
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

For Each cell In rng
cell.ClearContents
Next cell

TFTH,
Billy

I have also attached the rest of the macro..

Private Sub CommandButton1_Click()
Columns("A").Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(15, 1), Array
(47, 1), Array(64, 1))
Columns("A:A").Select
Range("A1:A2000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
Columns("A:A").Select
Selection.Copy
Dim cell As Range
Dim rng As Range

On Error Resume Next
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

For Each cell In rng
cell.ClearContents
Next cell
Sheets("Linked Table 1st shift").Select
Range("A1:O44").Select
Range("O44").Activate
Selection.PrintOut Copies:=1, Collate:=True
Sheets("Enter data").Select

End Sub

 

[Frank Kabel]

Hi
try:
Dim cell As Range
Dim rng As Range

On Error Resume Next
application.screenupdating=false
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

rng.ClearContents
application.screenupdating=true

 

[Billy C]

Thanks Frank....
It works perfect!

-----Original Message-----
Hi
try:
Dim cell As Range
Dim rng As Range

On Error Resume Next
application.screenupdating=false
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

rng.ClearContents
application.screenupdating=true

-----Original Message-----
Is there another way to re-write this VB to speed this
portion of my macro up?



Dim cell As Range
Dim rng As Range

On Error Resume Next
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

For Each cell In rng
cell.ClearContents
Next cell

TFTH,
Billy

I have also attached the rest of the macro..

Private Sub CommandButton1_Click()
Columns("A").Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(15, 1), Array
(47, 1), Array(64, 1))
Columns("A:A").Select
Range("A1:A2000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
Columns("A:A").Select
Selection.Copy
Dim cell As Range
Dim rng As Range

On Error Resume Next
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

For Each cell In rng
cell.ClearContents
Next cell
Sheets("Linked Table 1st shift").Select
Range("A1:O44").Select
Range("O44").Activate
Selection.PrintOut Copies:=1, Collate:=True
Sheets("Enter data").Select

End Sub

.

.

 

[Dana DeLouis]

If you wish, you may skip the Set statement as the "On Error" will take care
of that.

On Error Resume Next
Sheets("Enter data").Range("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues).ClearContents

If you want, you could attempt to remove some of the "Select" statements.
Here's just a quick and dirty attempt at a cleanup.

Private Sub CommandButton1_Click()
Dim cell As Range
Dim rng As Range

Columns("A").ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").TextToColumns Destination:=...etc
On Error Resume Next
ActiveSheet.UsedRange
Columns("A:A").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Columns("A:A").Copy

Sheets("Linked Table 1st shift").Select
Range("A1:O44").PrintOut Copies:=1, Collate:=True
Sheets("Enter data").Select
End Sub

HTH
--
Dana DeLouis
Win XP & Office 2003

Thanks Frank....
It works perfect!

-----Original Message-----
Hi
try:
Dim cell As Range
Dim rng As Range

On Error Resume Next
application.screenupdating=false
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

rng.ClearContents
application.screenupdating=true

-----Original Message-----
Is there another way to re-write this VB to speed this
portion of my macro up?



Dim cell As Range
Dim rng As Range

On Error Resume Next
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

For Each cell In rng
cell.ClearContents
Next cell

TFTH,
Billy

I have also attached the rest of the macro..

Private Sub CommandButton1_Click()
Columns("A").Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(15, 1), Array
(47, 1), Array(64, 1))
Columns("A:A").Select
Range("A1:A2000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
Columns("A:A").Select
Selection.Copy
Dim cell As Range
Dim rng As Range

On Error Resume Next
Set rng = Sheets("Enter data").Range
("C12000").SpecialCells(xlCellTypeConstants,
xlTextValues)
If rng Is Nothing Then Exit Sub

For Each cell In rng
cell.ClearContents
Next cell
Sheets("Linked Table 1st shift").Select
Range("A1:O44").Select
Range("O44").Activate
Selection.PrintOut Copies:=1, Collate:=True
Sheets("Enter data").Select

End Sub

.

.