I could use a hand with this one.

Printable View

Ok I have code here that will move the text that is highlighted in yellow in any cell in row C from worksheet A to the same postion in worksheet B.
VB Code:
Dim aColor As Integer
    Dim aCell As Range
    Dim aWorksheet As Worksheet
    Dim bWorksheet As Worksheet
    Set aWorksheet = Worksheets("DATA")
    Set bWorksheet = Worksheets("NegativeFMs")
    
    r1 = 2
    c1 = 1
    a1 = 1
    b1 = 1
    ' get color of  field C
    ' if it is yellow the copy to another workbook
    Do While aWorksheet.Cells(r1, c1 + 2) <> ""
        Set aCell = aWorksheet.Cells(r1, c1 + 2)
        aColor = aCell.Interior.ColorIndex
        If aColor = 6 Then
            bWorksheet.Cells(a1, b1).Value = "'" & aWorksheet.Cells(r1, c1 + 2).Value
            a1 = a1 + 1
        End If
        r1 = r1 + 1
    Loop
End Sub
But what i want to do is instead of moving the text of the yellow cell in row C to worksheet b, I want to move the whole row of any text in any cell thats bold in worksheet a to worksheet b

Example:
Worksheet A
A B C D E F G
N N Y N N N N
T T T S S T T

Workshhet B
A B C D E F G
N N Y N N N N

I hope this makes sense. This would really help me out ALOT, If not thanks for taking a look at it. :thumb:

Jan 4th, 2005, 04:50 PM
RobDog888

Re: I could use a hand with this one.
Welcome to the Forums.

Once you have your row you can select the entire row, copy it, select the
other sheet, and paste the row in. Change the indexes to your variables, etc.
Just a demo of the mechanics involved.
VB Code:
```
Workbooks(1).Sheets("Sheet1").Rows(1).Select
    Workbooks(1).Sheets("Sheet1").Rows(1).Copy
    Workbooks(1).Sheets("Sheet2").Activate
    Workbooks(1).Sheets("Sheet2").Paste Destination:=Workbooks(1).Sheets("Sheet2").Rows(1)
```
Jan 4th, 2005, 05:10 PM
The_Rookie

Re: I could use a hand with this one.

WOW! thanks for the quick reply RobDog888!!!

Thanks for the help but it looks like i would have to be specific with the row for it to copy the way you posted it there. And... what im trying to do is 1st locate the cell with bold text 2nd select the row that that cell is a part of then Paste it into the 2nd worksheet.

im a suppernoob if you cant tell...the code that i listed came from someone else who was trying to help but hes not availible anymore. I kinda understand it but some of it...most of it I dont. Im just being honest here. :blush:
but thanks for taking a look at it. :thumb:

Re: I could use a hand with this one.

No prob.
I had some time so I integrated my code with yours. I think this is how it should go...

VB Code:

Dim aColor As Integer
    Dim aCell As Range
    Dim aWorksheet As Worksheet
    Dim bWorksheet As Worksheet
    Set aWorksheet = Worksheets("DATA")
    Set bWorksheet = Worksheets("NegativeFMs")
    
    r1 = 2
    c1 = 1
    a1 = 1
    b1 = 1
    ' get color of  field C
    ' if it is yellow the copy to another workbook
    Do While aWorksheet.Cells(r1, c1 + 2) <> ""
        Set aCell = aWorksheet.Cells(r1, c1 + 2)
        aColor = aCell.Interior.ColorIndex
        If aColor = 6 Then
            bWorksheet.Cells(a1, b1).Value = "'" & aWorksheet.Cells(r1, c1 + 2).Value
            aWorksheet.Activate 'Make sure we are on aWorksheet
            aWorksheet.Rows(r1).Select
            aWorksheet.Rows(r1).Copy
            bWorksheet.Activate 'Switch to bWorksheet for the paste
            bWorksheet.Paste Destination:=bWorksheet.Rows(a1)
            aWorksheet.Activate 'Switch back
            a1 = a1 + 1
        End If
        r1 = r1 + 1
    Loop
End Sub

Jan 4th, 2005, 05:59 PM
The_Rookie

Re: I could use a hand with this one.
Hey Thanks man!!! :thumb:
im almost there now...I just changed it so that instead of anythig yellow
VB Code:
```
aColor = aCell.Interior.ColorIndex
        If aColor = 6 Then
```
..that it moves anything in bold text
VB Code:
```
aColor = aCell.Font.Bold
            If aColor = True Then
```
Now how would i get it to recognize ANY cell with bold text on Worksheet A and copy that row to woeksheet B? Cause right now it will just copy the row of any bold text in any cell in Colum C

im learning slowly but surley but im stuck right here.
Jan 4th, 2005, 06:02 PM
RobDog888

Re: I could use a hand with this one.

You would probably need to do a nested loop to loop accross the columns
looking at the cell in column A, B, C, ...
Jan 4th, 2005, 07:41 PM
The_Rookie

Re: I could use a hand with this one.

can you give an example of a nested loop (yes, I am that green)? Im gonna do some searching on the web to see if i can figure it out. :)

Re: I could use a hand with this one.

Nested loop inside another loop example.

VB Code:

Dim x As Integer 
Dim y As Integer
 
For x = 1 To 10
    For y = 1 To 20
        Msgbox x & y
    Next
Next

Jan 5th, 2005, 02:43 PM
The_Rookie

Re: I could use a hand with this one.

Ok i think im even more lost today.....It will still only copy the bold text in Colum C. :confused:
Jan 5th, 2005, 04:12 PM
RobDog888

Re: I could use a hand with this one.

No, it is just an example of how to place a loop inside another loop.

Re: I could use a hand with this one.

If I may stop in here....

Your code will only check one cell

VB Code:

Do While aWorksheet.Cells(r1, c1 + 2) <> ""
        Set aCell = aWorksheet.Cells(r1, c1 + 2)
        aColor = aCell.Interior.ColorIndex
        If aColor = 6 Then

You never change the Cell r1,c1+2, use Robdog888's suggestion for nested loops. First you musr decide which range you want to check (how many rows, how many columns)
Knowing that you do something like

VB Code:

For i=1 To NumberofRowsToCheck
    For j=1 to NumberOfColumnsToCheck
        Set aCell = aWorksheet.Cells(i, j)
        aColor = aCell.Font.Bold
        If aColor = True Then
             aWorksheet.Activate 'Make sure we are on aWorksheet
             aWorksheet.Rows(i).Select
             aWorksheet.Rows(i).Copy
             bWorksheet.Activate 'Switch to bWorksheet for the paste
             bWorksheet.Paste Destination:=bWorksheet.Rows(a1)
             a1=a1+1
            aWorksheet.Activate 'Switch back
        End If
    Next i
Next j

Hope that helps!

Jan 5th, 2005, 04:40 PM
RobDog888

Re: I could use a hand with this one.
I welcome anyone that wants to help anytime. :)

You can use this code snippet to determine the last column used so your
inner loop will not miss any columns.
VB Code:
```
ActiveWorkbook.Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Column
```
Jan 5th, 2005, 05:10 PM
The_Rookie

Re: I could use a hand with this one.
Ill give it a try but when i use the
VB Code:
```
For i=1 To NumberofRowsToCheck
    For j=1 to NumberOfColumnsToCheck
        Set aCell = aWorksheet.Cells(i, j)
```
Do i get rid of this all together?
VB Code:
```
Do While aWorksheet.Cells(r1, c1 + 2) <> ""
        Set aCell = aWorksheet.Cells(r1, c1 + 2)
```
And for the rows to check I just want to check the whole sheet so would i put in there 65536?

Thanks for all your paitence help fellas.... :thumb:

Re: I could use a hand with this one.

Got it to work for the most part but im using
VB Code:
i As Long
instad of integer
and putting in 65536 for the rows.......
is there any way to speed it up ?

And Also if 2 cells in the same row have bold text it pastes' it to bworksheet
twice....is there any way to avoid that from happening?
heres the code so far
VB Code:
Dim aColor As Integer
Dim aCell As Range
Dim aWorksheet As Worksheet
Dim bWorksheet As Worksheet
Dim i As Long
Dim j As Integer
Set aWorksheet = Worksheets("Console")
Set bWorksheet = Worksheets("Results")
 
r1 = 2
c1 = 1
a1 = 1
b1 = 1
' get Text of FM field
' if it is BOLD the copy to another workbook
For i = 2 To 65536
For j = 1 To 13
Set aCell = aWorksheet.Cells(i, j)
aColor = aCell.Font.Bold
If aColor = True Then
aWorksheet.Activate 'Make sure we are on aWorksheet
aWorksheet.Rows(i).Select
aWorksheet.Rows(i).Copy
bWorksheet.Activate 'Switch to bWorksheet for the paste
bWorksheet.Paste Destination:=bWorksheet.Rows(a1)
a1 = a1 + 1
End If
Next
Next
End Sub
Thanks for all the help guys ive become a office hero thanks to you!!! :thumb:

Re: I could use a hand with this one.

Sorry about the double pasting, I missed that.
you need to leave the column if you have fund one bold item.
Just insert a linwe like

VB Code:

j=NumberOfColumnsToCheck

after you have pasted

And for the speeding up use RobDog888s snippet the check for the last rownumber used.
it would look something like that:

VB Code:

Dim aColor As Integer
Dim aCell As Range
Dim aWorksheet As Worksheet
Dim bWorksheet As Worksheet
Dim i As Long
Dim j As Integer
Set aWorksheet = Worksheets("Console")
Set bWorksheet = Worksheets("Results")
 
r1 = 2
c1 = 1
a1 = 1
b1 = 1
' get Text of FM field
' if it is BOLD the copy to another workbook
For i = 2 To aWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For j = 1 To 13
Set aCell = aWorksheet.Cells(i, j)
aColor = aCell.Font.Bold
If aColor = True Then
aWorksheet.Activate 'Make sure we are on aWorksheet
aWorksheet.Rows(i).Select
aWorksheet.Rows(i).Copy
bWorksheet.Activate 'Switch to bWorksheet for the paste
bWorksheet.Paste Destination:=bWorksheet.Rows(a1)
a1 = a1 + 1
j=13
End If
Next
Next
End Sub

Jan 6th, 2005, 07:10 PM
The_Rookie

Re: I could use a hand with this one.

Thanks for the Reply opus it works well

But Somethimes I have alot of data...and the scrren looks like its going to explode because i guess its checking back and forth for every cell then pasing it to bworkbook... Is there a way that we can do it where it shows the progress of the process on a status bar of some sort on aworksheet then when its complete...switch over to bworksheet for viewing the results?

Again thanks for your time and your help.