mrjason2008
06-11-2012, 10:02 PM
Hallo,
I am relatively new to VBA and created a macro, which copies data matching a search term out the 'Database' worksheet into a separate worksheet 'SearchOutput'.
The worksheet 'Database' contains the search term in cell AY2 and the database itself in cell range BM7:PO500. My macro loops through the database and copies every cell, which contains the search term (measured by COUNTIF), into the first free row in worksheet 'SearchOutput'. It also copies two other cells immediately to the right of the cell, which contained the search term.
It took me a few hours to come up with a macro that works :-) However, I noticed that the macro is quite slow, probably because it contains a number of SELECT statements. I searched through the forum and noticed that many people advise to avoid using SELECT and instead to define variables. However, in my specific case, I struggled with understanding how I can achieve the same outcome without using SELECT.
Could you help me? My current code is the following:
Sub CopyDataToSearchOutput()
Dim Datfield As Range
Dim WordPos As Integer
Sheets("Database").Select
Application.ScreenUpdating = False
For Each Datfield In Sheets("Database").Range("BM7:PO500")
'jump over all the calcs if the cell is empty
If Datfield.Text = "" Then GoTo CellEmpty:
'check that the respective cell contains the search term in cell AY2
WordPos = Application.WorksheetFunction.CountIf(Datfield, Range("AY2"))
If WordPos <> 0 Then 'do this if the cell contains the search term
'copy the cell which contains the search term
Datfield.Copy
Sheets("SearchOutput").Select
Range("C1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy the corresponding name
Worksheets("Database").Cells(Datfield.Row, Datfield.Column + 1).Copy
Sheets("SearchOutput").Select
Range("D1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy the corresponding unit field
Worksheets("Database").Cells(Datfield.Row, Datfield.Column + 2).Copy
Sheets("SearchOutput").Select
Range("E1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Database").Select
End If
CellEmpty: 'jump here if cell is empty
Next Datfield
Application.ScreenUpdating = True
Sheets("SearchOutput").Select
Range("B1").Select
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
End Sub
Thank you very much in advance for your help. I really appreciate it!
I am relatively new to VBA and created a macro, which copies data matching a search term out the 'Database' worksheet into a separate worksheet 'SearchOutput'.
The worksheet 'Database' contains the search term in cell AY2 and the database itself in cell range BM7:PO500. My macro loops through the database and copies every cell, which contains the search term (measured by COUNTIF), into the first free row in worksheet 'SearchOutput'. It also copies two other cells immediately to the right of the cell, which contained the search term.
It took me a few hours to come up with a macro that works :-) However, I noticed that the macro is quite slow, probably because it contains a number of SELECT statements. I searched through the forum and noticed that many people advise to avoid using SELECT and instead to define variables. However, in my specific case, I struggled with understanding how I can achieve the same outcome without using SELECT.
Could you help me? My current code is the following:
Sub CopyDataToSearchOutput()
Dim Datfield As Range
Dim WordPos As Integer
Sheets("Database").Select
Application.ScreenUpdating = False
For Each Datfield In Sheets("Database").Range("BM7:PO500")
'jump over all the calcs if the cell is empty
If Datfield.Text = "" Then GoTo CellEmpty:
'check that the respective cell contains the search term in cell AY2
WordPos = Application.WorksheetFunction.CountIf(Datfield, Range("AY2"))
If WordPos <> 0 Then 'do this if the cell contains the search term
'copy the cell which contains the search term
Datfield.Copy
Sheets("SearchOutput").Select
Range("C1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy the corresponding name
Worksheets("Database").Cells(Datfield.Row, Datfield.Column + 1).Copy
Sheets("SearchOutput").Select
Range("D1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'copy the corresponding unit field
Worksheets("Database").Cells(Datfield.Row, Datfield.Column + 2).Copy
Sheets("SearchOutput").Select
Range("E1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Database").Select
End If
CellEmpty: 'jump here if cell is empty
Next Datfield
Application.ScreenUpdating = True
Sheets("SearchOutput").Select
Range("B1").Select
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
End Sub
Thank you very much in advance for your help. I really appreciate it!