COPY BOLD, SENT TO SHEET 2 OR A SHEET NAMED "?" 2

[natedeia]

If a cell in sheet one is BOLD, then copy and paste entire row onto sheet 2. or a sheet name,


Option Explicit

Sub TransferDataPlease()
Dim i As Long, n As Long
n = 1
n = n + 1
For i = Range("A65536").End(xlUp).Row To 1 Step -1
If Range("A" & i).Font.Bold = "TRUE" Then
Range("A" & i).EntireRow.Copy Sheets("One").Range("A" & n)
End If
Next i
End Sub

 

[VBAjedi]

Something like this should work:

Sub TransferDataPlease()
Dim i As Long, n As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet

Set Sh1 = ActiveSheet
Set Sh2 = Worksheets("Sheet2") ' insert name here
n = 1
For i = Sh1.Range("A65536").End(xlUp).Row To 1 Step -1
    If Sh1.Range("A" & i).Font.Bold = True Then
        n = n + 1
        Sh1.Range("A" & i).EntireRow.Copy Sh2.Range("A" & n)
    End If
Next i
End Sub

Note that True is a constant and should not be in quotes. . .

VBAjedi

 

[natedeia]

great code, runs smoother than

Sub AddToNegative()

' Macro2 Macro

Call ClearNegative
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("DATA")
Set bWorksheet = Worksheets("Negative")

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 500
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


but can you make your code do all more columns??? my code is alot slower and we keep getting duplicate ones. like if a row has two bolded cells then it dups that row there that many times.

 

[VBAjedi]

There's probably a slicker way to check multiple cells to see if one is bold, but this should work:

Sub TransferDataPlease()
Dim i As Long, n As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet

Set Sh1 = ActiveSheet
Set Sh2 = Worksheets("Sheet2") ' insert name here
n = 1
For x = Sh1.Range("A65536").End(xlUp).Row To 1 Step -1
    y = 0
    IsBold = False
    Do
        y = y + 1
        If Sh1.Cells(x, y).Font.Bold = True Then IsBold = True
    Loop While y <= 13 And IsBold = False ' Checks first 13 cols
    If IsBold Then
        n = n + 1
        Sh1.Range("A" & x).EntireRow.Copy Sh2.Range("A" & n)
    End If
Next x
End Sub

Obviously, because this works from the bottom of the sheet to the top, this will list all found occurrences in reverse order. All you have to do to fix that is flip the two arguments of the "For x" statement around (and remove the "Step -1" part).



VBAjedi

 

[natedeia]

my old one was entertaining, but this one works great. like always. thanks for the smarts again

 

[VBAjedi]

Hey, sometimes "entertaining" is preferrable to "efficient", but I'm glad my code was helpful in this case.

Cheers!


VBAjedi

 

[natedeia]

Sh1.Range("A" & x).EntireRow.Copy Sh2.Range("A" & n)
End If

With the code above, the "A", can't I make that A4 for sh1 and A2 for sh2?
I have been trying to adapt it to my sheet better cause I have either 3 or 1 rows at the top which I have some cells that have the titles which those have validation cells for some conditional statements for highlighting specific ranges in dollar amounts and time , stuff like that.
As you know, not a pro here but just thought it would be that simple, i see the A65536 for the range , just can't figure it out.

 

[VBAjedi]

Not quite sure what you are asking. . . to adjust for header rows on Sh1, just change the "1" in the "For x" statement to "4" (or whatever row number the data starts on). To start writing results on Sh2 to a different row than row 1, just change "n = 1" to "n = 2" or whatever. . .

If I've misunderstood your question please clarify what you are after. . .

VBAjedi

 

[natedeia]

It's me, I don't know what I am talking about. Still picking this up. But what you said is exactly what I was trying to do. I was just changing the wrong thing or not reading the code correctly, just ignorant to alot of the rules. That little thing helped out alot, soon it will be lesser and lesser questions,no I am serious. Thanks again!

 

[VBAjedi]

Don't worry - you'll get it! You're learning exactly the way I did. Set out to solve something, get stuck, post to Tek-Tips, get suggestions, struggle a bit to apply them to your situation, finally get it working, repeat.



But each time you learn a bit more, and it's surprising how fast all those little facts add up! I probably increased my VBA knowledge and ability ten-fold during the first year I participated here at Tek-Tips.

Say, if you will email me at:

jedi at obie dot com

I'll send you a little Word file I have compiled with a bunch of useful VBA code snippets. It's stuff I still refer to almost every day, and I'm sure there's things in there you would find helpful.

VBAjedi