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

 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

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
75,734
Office Version
365
Platform
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
75,734
Office Version
365
Platform
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
75,734
Office Version
365
Platform
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
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,226
Messages
5,509,916
Members
408,763
Latest member
kinhcuonglucvinh

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top