Zygote Assistance: Search by Font, Copy to New Worksheet

[Factor3]

Deepest apologies for the inexperience, I'm about 10 hours deep into VBA (but persistently putting in time), and can't find this in the current string in the forums.

Situation: A workbook with multiple sheets (listing dates, cost, & amount: columns "A:C"). They detail my annual expenses of which some are tax deductible as business expense, and some aren't. The ones that are, I have gone through and bolded (the entire row) in each worksheet within the workbook.

Goal: I want to create a macro to search each worksheet's columns ("A:C"), copy all of the rows that I have bolded (i.e. can be deductible for business expense), and paste into a new worksheet that is created called "Summary".

Sincerely,

The Zygote

P.S. I just took a course on VBA (6 hours long), what is the best way to "practice" VBA, I'm having a REALLY tough time writing my own code (I'm trying to get away from the "record & click" method).

[Ken Puls]

Situation: A workbook with multiple sheets (listing dates, cost, & amount: columns "A:C"). They detail my annual expenses of which some are tax deductible as business expense, and some aren't. The ones that are, I have gone through and bolded (the entire row) in each worksheet within the workbook.

Goal: I want to create a macro to search each worksheet's columns ("A:C"), copy all of the rows that I have bolded (i.e. can be deductible for business expense), and paste into a new worksheet that is created called "Summary".

This is not the most elegeant, but it will work. This is quick n easy, so:
-Create a Summary worksheet
-Run this code on each sheet that you want to copy from

Sub CopyBold()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cl As Range

'Set your worksheets here
Set ws1 = ActiveSheet
Set ws2 = Worksheets("Sheet2")

'Copy each bold row to next row on next sheet
For Each cl In ws1.Range("A1:A" & Cells(ws1.Rows.Count, 1).End(xlUp).Row)
If cl.Font.Bold = True Then
cl.EntireRow.Copy ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1, 0)
End If
Next cl
End Sub



P.S. I just took a course on VBA (6 hours long), what is the best way to "practice" VBA, I'm having a REALLY tough time writing my own code (I'm trying to get away from the "record & click" method).

Try working through the answers in the forums. :) Compare your work to what is provided and accepted as the solution. Ask questions. All of that is the way that most of us learned our craft here. ;)

HTH,

[Factor3]

So I cut and pasted the VBA into the editor. When I tried running the Macro on the first Worksheet I got the message "Run-time error '9': Subscript out of Range.

When debugging, it's stuck at the line:
Set ws2 = Worksheets("Sheet2")

I changed the line to read:
Set ws2 = Worksheets("Summary!"), but that didn't fix it (got the same error).

If it helps, worksheet names are:
05-11-2006
06-13-2006
07-13-2006 ...

The Summary Worksheet is called Summary.

What am I missing??

[Ken Puls]

Take the ! off Summary. :)

[Factor3]

That's IT!!!

What would a macro look like that could then run this on an entire workbook instead of having to through sheet by sheet? (I've got about 50 worksheet overall in 6 different workbooks, so automating it would save a ton of time).

I'm assuming I've gotta throw a loop in there somewhere

[Ken Puls]

Yes, you'd want to exclude the Summary sheet too.

I don't know why I had to activate the first sheet to do this, but I don't have time to look into it, as I have to go into a meeting. Try this:
Sub CopyBold()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cl As Range

'Set your worksheets here
Worksheets(1).Activate
Set ws2 = Worksheets("Summary")

For Each ws1 In ActiveWorkbook.Worksheets
If Not ws1.Name = ws2.Name Then
'Copy each bold row to next row on next sheet
For Each cl In ws1.Range("A1:A" & Cells(ws1.Rows.Count, 1).End(xlUp).Row)
If cl.Font.Bold = True Then
cl.EntireRow.Copy ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1, 0)
End If
Next cl
End If
Next ws1
End Sub

[Factor3]

Ken, thank you tremendously for your help, that did it. My deepest gratitude.

Now I've just got to figure what it all means:)