Elvis
07-13-2009, 07:35 AM
I'm using the macros below to consolidate raw data into a new workbook and delete any rows where any columns have empty cells.
It's a two stage process:
1) The first macro copys and pastes the relevant data into a new workbook. Currently the data extends from row 4 to 8755, each named range represents a column. This macro runs relatively quickly.
2) Another macro is then calls another macro that deletes rows with empty cells in any given column. This seems to take a lot of time to run.
Am wondering if there is a more efficient faster way of doing this?
Thanks,
Elvis
----------------------------------------
Sub Consolidate_index_Data() 'collates raw data
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Test\Risk.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'Dates
ThisWorkbook.Sheets("Table").Activate 'use activate when working between workbooks
Range("A1:a10000").Copy
Workbooks("riskindex.xls").Sheets("sheet1").Activate
Range("a1").Select
ActiveSheet.Paste
'next data series
ThisWorkbook.Sheets("Table").Activate
Range("swissfranc").Select
Selection.Copy
Workbooks("riskindex.xls").Sheets("Sheet1").Activate
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'next
ThisWorkbook.Sheets("Table").Activate
Range("gold").Select
Selection.Copy
Workbooks("riskindex.xls").Sheets("Sheet1").Activate
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Next
ThisWorkbook.Sheets("Table").Activate
Range("DAAA").Select
Selection.Copy
Workbooks("riskindex.xls").Sheets("Sheet1").Activate
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ditto above for another 12 series pasted to column P, not shown here to save space
call delete_rows
End Sub
2nd Macro
Sub Delete_rows()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim i As Long
Dim myRng As Range
Dim sh As Worksheet
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can also use Sheets("MySheet")
Set sh = ActiveSheet
'We search in column A in this example
Set myRng = sh.Range("A:J")
'Add more search strings if you need
myStrings = Array("#N/A", "")
With sh
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'We will search the values in MyRng in this example
With myRng
For i = LBound(myStrings) To UBound(myStrings)
Do
Set FoundCell = myRng.Find(What:=myStrings(i), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'Use xlPart If you want to search in a part of the FoundCell
'If you use LookIn:=xlValues it will also delete rows with a
'formula that evaluates to "Ron"
If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
Loop
Next i
End With
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
End Sub
It's a two stage process:
1) The first macro copys and pastes the relevant data into a new workbook. Currently the data extends from row 4 to 8755, each named range represents a column. This macro runs relatively quickly.
2) Another macro is then calls another macro that deletes rows with empty cells in any given column. This seems to take a lot of time to run.
Am wondering if there is a more efficient faster way of doing this?
Thanks,
Elvis
----------------------------------------
Sub Consolidate_index_Data() 'collates raw data
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Test\Risk.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'Dates
ThisWorkbook.Sheets("Table").Activate 'use activate when working between workbooks
Range("A1:a10000").Copy
Workbooks("riskindex.xls").Sheets("sheet1").Activate
Range("a1").Select
ActiveSheet.Paste
'next data series
ThisWorkbook.Sheets("Table").Activate
Range("swissfranc").Select
Selection.Copy
Workbooks("riskindex.xls").Sheets("Sheet1").Activate
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'next
ThisWorkbook.Sheets("Table").Activate
Range("gold").Select
Selection.Copy
Workbooks("riskindex.xls").Sheets("Sheet1").Activate
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Next
ThisWorkbook.Sheets("Table").Activate
Range("DAAA").Select
Selection.Copy
Workbooks("riskindex.xls").Sheets("Sheet1").Activate
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ditto above for another 12 series pasted to column P, not shown here to save space
call delete_rows
End Sub
2nd Macro
Sub Delete_rows()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim i As Long
Dim myRng As Range
Dim sh As Worksheet
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can also use Sheets("MySheet")
Set sh = ActiveSheet
'We search in column A in this example
Set myRng = sh.Range("A:J")
'Add more search strings if you need
myStrings = Array("#N/A", "")
With sh
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'We will search the values in MyRng in this example
With myRng
For i = LBound(myStrings) To UBound(myStrings)
Do
Set FoundCell = myRng.Find(What:=myStrings(i), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'Use xlPart If you want to search in a part of the FoundCell
'If you use LookIn:=xlValues it will also delete rows with a
'formula that evaluates to "Ron"
If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
Loop
Next i
End With
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
End Sub