help with vba adaption

blueroost

New Member
Joined
Jul 15, 2010
Messages
42
Came across this code but trying to adapt it slightly

The code searches column e for the word bottle, copies and pastes the whole row where the word bottle appears in sheet 2.

What i want to change is ;

search a range ie - a4:f20 (as opposed to only column e)

Search criteria will be by font colour (blue for example ) Font.ColorIndex = 5 and only if there is no other fill colour in the cell.

Have tried to adapt but i keep getting errors , Original Code;

Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub



Many Thanks

 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

blueroost

New Member
Joined
Jul 15, 2010
Messages
42
Slight change to original e mail, (criteria is mail box not bottles)

Came across this code but trying to adapt it slightly

The code searches column e for the word "Mail Box", copies and pastes the whole row where the word bottle appears in sheet 2.

What i want to change is ;

search a range ie - a4:f20 (as opposed to only column e)

Search criteria will be by font colour (blue for example ) Font.ColorIndex = 5 and only if there is no other fill colour in the cell.

Have tried to adapt but i keep getting errors , Original Code;

Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub



Many Thanks
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,299
Office Version
  1. 365
Platform
  1. Windows
Can you post the adapted code and tell us how it isn't working?
 

blueroost

New Member
Joined
Jul 15, 2010
Messages
42
ok, not too clued up on vba so will highlight in red what i changed in a hope that it would search range a4:f20 for anything with font colour blue, then paste in new sheet


Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("A4:F20" & CStr(LSearchRow)).Value = Font.ColorIndex = 5 Then

'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub



Many Thanks
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,299
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I'm afraid that will definitely not search the range, for the colour index or anything else.

You can't really search an entire range in one fell swoop like that.

The original code is searching column E row by row (or cell by cell I suppose) then copying and pasting if the criteria is found.

What exactly is your criteria?

The range you mention has 6 columns and multiple rows.:)
 

blueroost

New Member
Joined
Jul 15, 2010
Messages
42
mmmm, this does not look good

The range i am searching has 13 column and around 150 rows

basically searching due dates, they will change colour when due out of date etc.

my idea was due dates that have not been dealt with "amber font and no colour fill", could be copied into new sheet.

a kind of filtering report.
 

blueroost

New Member
Joined
Jul 15, 2010
Messages
42

ADVERTISEMENT

ok found another code that finds the blue font

Sub findBlueCharacter()
Dim cl As Range
Dim iCharacter As Integer
For Each cl In ActiveSheet.Range("a1:c2")
If Len(cl) > 0 Then
For iCharacter = 1 To cl.Characters.Count
If cl.Characters(iCharacter, 1).Font.ColorIndex = 5 Then
cl.Select
Exit Sub
End If
Next iCharacter
End If
Next cl
End Sub


is there any way i could mash these two together so that it

finds the font colour

copy / paste row

look for next row with font colour

copy / paste row

until it reaches the end (blank cell i guess)
 

blueroost

New Member
Joined
Jul 15, 2010
Messages
42
Do I have to repeat search for each column , if so how do i search the font colour

help please, not much hair left
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,299
Office Version
  1. 365
Platform
  1. Windows
It's still not clear exactly what the criteria is.

The code you've posted now is checking the font colour of every character of every value in the range A1:C2.

What is it you want to check for?

Do you want to check row by row, column by column, cell by cell?
 

blueroost

New Member
Joined
Jul 15, 2010
Messages
42
I want it to look at a range, not sure how it will do it, row by row etc

it will look for the cell that has the "font colour of choice" lets say amber

there will only be one in each row, cell in row will change as per calender but will always only be one cell with amber coloured font in each row.

the amber coloured font represents a due date.

if i do the task that is due, i will fill the cell grey, (font will still be amber, its conditional formatting)

so i want to scan through my range, find the cells that have amber font and not filled with a colour and paste that entire row in a new sheet.

i have explained it slightly different in this post with screen shot
http://www.mrexcel.com/forum/showthread.php?t=484652&highlight=copy+filter

it could be impossible but seems so simple

thank you for your replies
 

Watch MrExcel Video

Forum statistics

Threads
1,133,755
Messages
5,660,756
Members
418,591
Latest member
clayest94

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top