ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   How do I use the font as a filter (https://www.excelbanter.com/excel-programming/345185-how-do-i-use-font-filter.html)

Karlos[_3_]

How do I use the font as a filter
 

I am struggling with a export problem purely due to the size of task.

I have over 50000 rows of text in excel. I would like to copy all th
text that is a certain font size to a new sheet, in th same position a
found, this would leave behind all other data.

Another macro would bring out all data based on a word.

Effectively the fonted data would copy first then the 2nd macro woul
look for an instance of the target word, if found then copy that wor
to under the previous fonted data. The first macro would then continu
to look for more fonted data and so on.

Can any one help I am on a very tight schedule and lack of sleep i
driving me mad

--
Karlo
-----------------------------------------------------------------------
Karlos's Profile: http://www.excelforum.com/member.php...fo&userid=2864
View this thread: http://www.excelforum.com/showthread.php?threadid=48361


Tom Ogilvy

How do I use the font as a filter
 
Dim rng as Range, cell as Range
With worksheets("Sheet1")
set rng = .Range(.cells(1,1),.cells(rows.count,1).End(xlup))
End With
for each cell in rng
if cell.Font.size = 12 then
cell.EntireRow.copy Destination:= _
worksheets("Sheet2").Cells(cell.row,1)
end if
Next
set rng = worksheets("Sheet1").cells.Find("Target" _
Lookin:=xlValues,LookAt:=xlPart)
if not rng is nothing then
sAddr = rng.Address
do
rng.Entirerow.copy Destination:= _
worksheets("Sheet2").Cells(rng.row,1)
set rng = cell.FindNext(rng)
Loop until rng.Address = sAddr
end if

--
Regards,
Tom Ogilvy


"Karlos" wrote in
message ...

I am struggling with a export problem purely due to the size of task.

I have over 50000 rows of text in excel. I would like to copy all the
text that is a certain font size to a new sheet, in th same position as
found, this would leave behind all other data.

Another macro would bring out all data based on a word.

Effectively the fonted data would copy first then the 2nd macro would
look for an instance of the target word, if found then copy that word
to under the previous fonted data. The first macro would then continue
to look for more fonted data and so on.

Can any one help I am on a very tight schedule and lack of sleep is
driving me mad.


--
Karlos
------------------------------------------------------------------------
Karlos's Profile:

http://www.excelforum.com/member.php...o&userid=28649
View this thread: http://www.excelforum.com/showthread...hreadid=483612




Karlos[_4_]

How do I use the font as a filter
 

Thanks - can't see the wood for the trees, thanks for the routine this
has put me on the right track.


--
Karlos
------------------------------------------------------------------------
Karlos's Profile: http://www.excelforum.com/member.php...o&userid=28649
View this thread: http://www.excelforum.com/showthread...hreadid=483612


Karlos[_5_]

How do I use the font as a filter
 

Below is full script not mine, I hasten - still a little out of my depth
but willing to learn. The bottom half does not want to loop and stops
after one pass. What am I missing?

Dim rng as Range, cell as Range
With worksheets("Sheet1")
set rng = .Range(.cells(1,1),.cells(rows.count,1).End(xlup))
End With
for each cell in rng
if cell.Font.size = 12 then
cell.EntireRow.copy Destination:= _
worksheets("Sheet2").Cells(cell.row,1)
end if
Next
set rng = worksheets("Sheet1").cells.Find("Target" _
Lookin:=xlValues,LookAt:=xlPart)
if not rng is nothing then
sAddr = rng.Address
do
rng.Entirerow.copy Destination:= _
worksheets("Sheet2").Cells(rng.row,1)
set rng = cell.FindNext(rng)
Loop until rng.Address = sAddr
end if


--
Karlos
------------------------------------------------------------------------
Karlos's Profile: http://www.excelforum.com/member.php...o&userid=28649
View this thread: http://www.excelforum.com/showthread...hreadid=483612


Tom Ogilvy

How do I use the font as a filter
 
Well, there were a couple of typos in the code, but after cleaning them up,
it ran fine for me:

Sub ABCD()
Dim rng As Range, cell As Range
With Worksheets("Sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In rng
If cell.Font.Size = 12 Then
cell.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(cell.Row, 1)
End If
Next
Set rng = Worksheets("Sheet1").Cells.Find("Target", _
LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(rng.Row, 1)
Set rng = Cells.FindNext(rng)
Loop Until rng.Address = sAddr
End If
End Sub

--
Regards,
Tom Ogilvy


"Karlos" wrote in
message ...

Below is full script not mine, I hasten - still a little out of my depth
but willing to learn. The bottom half does not want to loop and stops
after one pass. What am I missing?

Dim rng as Range, cell as Range
With worksheets("Sheet1")
set rng = .Range(.cells(1,1),.cells(rows.count,1).End(xlup))
End With
for each cell in rng
if cell.Font.size = 12 then
cell.EntireRow.copy Destination:= _
worksheets("Sheet2").Cells(cell.row,1)
end if
Next
set rng = worksheets("Sheet1").cells.Find("Target" _
Lookin:=xlValues,LookAt:=xlPart)
if not rng is nothing then
sAddr = rng.Address
do
rng.Entirerow.copy Destination:= _
worksheets("Sheet2").Cells(rng.row,1)
set rng = cell.FindNext(rng)
Loop until rng.Address = sAddr
end if


--
Karlos
------------------------------------------------------------------------
Karlos's Profile:

http://www.excelforum.com/member.php...o&userid=28649
View this thread: http://www.excelforum.com/showthread...hreadid=483612




Karlos[_7_]

How do I use the font as a filter
 

Thanks - I'm going to have to learn VBA macros etc


--
Karlos
------------------------------------------------------------------------
Karlos's Profile: http://www.excelforum.com/member.php...o&userid=28649
View this thread: http://www.excelforum.com/showthread...hreadid=483612



All times are GMT +1. The time now is 10:32 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com