COPY A ROW BASED ON FONT COLOR

[geno32080]

Hello Excel community,
I have been searching every where. I'm looking for a a macro that when activated with a command button will search the active sheet column B thru F, rows 2 thru 50. find cells with red uppercase font and copy them. I set up a macro so that when the user types in that cell range and tabs to the next cell it changes that font to uppercase and also changes the font to red. The new macro needs to copy that random row, and then will need to paste it to B6, B7, B8, B9 and b10 on a different sheet in the same work book. Is that even possible? any help will be greatly appreciated. Thank you.
Below is an example, copy B2 (customer name) on the active work sheet and paste to B6 on the other sheet, copy C2 (company name) and paste B7, copy D2( manufacture) and paste to B8, copy E2 (model number)and paste to B9 and lastly copy F2 ( phone number) and paste to B10 on the other sheet. The copy feature needs to search the active sheet columns B thru F and Rows 2 Thru 50.

 

[Joe4]

OK, it appears that your Conditional Formatting will only ever format one row at a time, so it looks like we can exit the loop once it finds a match.
I think this should do all that you want:

Sub MyCopyData()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim r1 As Long

'   Set data sheet to copy from
    Set ws1 = Sheets("Customer Information")
'   Set sheet to copy to
    Set ws2 = Sheets("Create Work Order")

    Application.ScreenUpdating = False

'   Loop through rows on sheet 1
    ws1.Activate
    For r1 = 2 To 50
'       Check to see if column B is bold and red
        If (Cells(r1, "B").DisplayFormat.Font.Color = vbRed) And _
            (Cells(r1, "B").DisplayFormat.Font.Bold = True) Then
'           Copy to destination sheet
            ws1.Range(Cells(r1, "B"), Cells(r1, "F")).Copy
            ws2.Range("B6").PasteSpecial Transpose:=True
            Application.CutCopyMode = False
'           Clear conditional formatting from copied range
            ws2.Range("B6:B10").FormatConditions.Delete
'           Exit loop
            Exit For
        End If
    Next r1
          
    Application.ScreenUpdating = True
  
End Sub

 

[geno32080]

I decided to work on this before going off to work today. Thats the ticket! I learned alot of stuff. I appreciate all your efforts. Until the next hurdle?

 

[Joe4]

I decided to work on this before going off to work today. Thats the ticket! I learned alot of stuff. I appreciate all your efforts. Until the next hurdle?

Does that mean that my code does what you want, or you came up with your own solution?

 

[geno32080]

Does that mean that my code does what you want, or you came up with your own solution?

I'm sorry for not being clear, the code works great! O marked it as solved.,

 

[geno32080]

Joe, do you want to work with me on the next part of the project? It involves getting the Service Data copied to the Create Work Order sheet..

 

[Joe4]

Joe, do you want to work with me on the next part of the project? It involves getting the Service Data copied to the Create Work Order sheet..

There really aren't "assigned" people to particular questions, nor do you really get to "choose" who works on your questions.
Simply post your new question to the forum, and people who think they can help and are willing will respond (I may or may not be one of these people - it depends on the nature of the question and the availability I have at the time).