Help! How can I do this?

[Patrick]

All,
I need help. I have an excel file that contains 2 worksheets; extended
and breakdown. On the extended sheet I have a bunch of columns that
contain data. What I'm trying to accomplish is any on the cells that
contain the word "yes", I would like to copy the contents 2 cells over
to the breakdown sheet. Looks something like this:

title desc sold
Book1 myself Yes

I would like a formula or macro that would copy the cell contents (in
this case book1) to a range in the worksheet entitled breakdown based
on the "yes" value 2 cells over. Any suggestions.....Unfortuantely Its
a lot of data....

Please help

 

[Ken Johnson]

Hi Patrick,

Will selecting the sold column then filtering it by going
Data|Filter|Autofilter then clicking the AutoFilter's down arrow and
selecting "Yes" from the list, then copying the Title column and
pasting into the breakdown sheet do?

Ken Johnson

 

[Patrick]

Well, the thing is that the sheet is going to constantly be updated
with items changed from "no" to "yes" so the copy and paste thing would
have to be done all the time. What I'm looking for is possibly either a
macro or a formula that will do it automatically.

 

[Ken Johnson]

Hi Patrick,

Try out this macro on a COPY of your workbook...

Option Base 1
Public Sub SoldBooks()
Dim vaData As Variant
Dim vaSoldBooks() As String
Dim iLastRow As Long
Dim iLAstRowbd As Long

Dim iLastColumn As Integer
Dim iHeading As Integer
Dim iBookCount As Long
Dim iSoldCounter As Long
Dim iSoldColumn As Integer
With Worksheets("extended")
iLastColumn = _
..Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column
iLastRow = .Range("A" & .Range("A:A").Rows.Count).End(xlUp).Row
vaData = .Range(.Cells(1, 1), .Cells(iLastRow, iLastColumn))
End With

For iHeading = 1 To iLastColumn
If UCase(vaData(1, iHeading)) = "SOLD" Then
Let iSoldColumn = iHeading
Exit For
End If
Next iHeading
If iSoldColumn = 0 Then
MsgBox "Can't find 'Sold' Column"
Exit Sub
End If
For iBookCount = 1 To iLastRow
If UCase(vaData(iBookCount, iHeading)) = "YES" Then
Let iSoldCounter = iSoldCounter + 1
ReDim Preserve vaSoldBooks(iSoldCounter)
vaSoldBooks(iSoldCounter) = vaData(iBookCount, iHeading - 2)
End If
Next iBookCount
With Worksheets("breakdown")
iLAstRowbd = _
IIf(.Range("A" & .Range("A:A").Rows.Count).End(xlUp).Row < 3, 3, _
..Range("A" & .Range("A:A").Rows.Count).End(xlUp).Row)
..Range("A2:A" & iLAstRowbd).ClearContents
..Range("A2").Resize(UBound(vaSoldBooks), 1) _
..Value = WorksheetFunction.Transpose(vaSoldBooks)
End With

I didn't know where on the extended worksheet the sold column is so the
code does rely on the heading "sold" being somewhere in row 1. It is
not case sensitive so it can be any combination lower case and
capitals.

The code is set up to copy the sold books titles into column A of the
breakdown sheet, starting on row 2.

Every time you run the macro the old data in column A breakdown is
cleared before the copied sold titles are pasted.

The code can be run from any worksheet in the workbook, and also relies
on the sheets names being "breakdown" and "extended", again not case
sensitive.

The code could also be used as a WorksheetActivate Event Procedure so
that you wouldn't have to bother with manually running the macro. Excel
would run it automatically everytime you activated the breakdown sheet
when you click its worksheet tab.

Let me know how you go. I can make any needed changes.

Ken Johnson

 

[Patrick]

Ken,
Thanks for the response. The code works great! You da man! But I
have a question concerning the code, Currently, with your code, the
sheet works as expected (thanks) but I was thinking about making the
extended sheet and the breakdown sheet a little prettier and more
appealing to the reader.....If I was going to move the sold column down
some rows or wanted the copied data on the breakdown sheet in another
columns what lines of your code should I alter (I don't want to mess
your code up). And would your code support named ranges?

 

[Ken Johnson]

Hi Patrick,

try this out on a COPY of your data...

Option Base 1
Public Sub SoldBooks()
Const strSoldTitlesColumn As String = "A"
Const strSoldTitlesHeading As String = "Sold Titles"
Dim vaData As Variant
Dim vaSoldBooks() As String
Dim iLastRow As Long
Dim iLAstRowbd As Long
Dim iLastColumn As Integer
Dim iHeading As Integer
Dim iBookCount As Long
Dim iSoldCounter As Long
Dim iSoldColumn As Integer
Dim iTitleColumn As Integer
'Find the right-most column heading column,
'bottom-most data row and load vaData array with
'all the data on sheet named "extended"
With Worksheets("extended")
iLastColumn = _
..Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column
iLastRow = .Range("A" & .Range("A:A").Rows.Count).End(xlUp).Row
vaData = .Range(.Cells(1, 1), .Cells(iLastRow, iLastColumn))
End With
'Find the "SOLD" and "TITLE" headings in row 1 of the
'vaData array. Assign their column numbers to iSoldColumn and
'iTitleColumn respectively.
For iHeading = 1 To iLastColumn
Select Case UCase(vaData(1, iHeading))
Case "SOLD"
Let iSoldColumn = iHeading
Case "TITLE"
Let iTitleColumn = iHeading
End Select
If iSoldColumn And iTitleColumn <> 0 Then Exit For
Next iHeading
'If "SOLD" heading not found, tell user then Exit Sub
If iSoldColumn = 0 Then
MsgBox "Can't find 'Sold' Column"
Exit Sub
End If
'If "TITLE" heading not found, tell user then Exit Sub
If iTitleColumn = 0 Then
MsgBox "Can't find 'Title' Column"
Exit Sub
End If
'Search "SOLD" column for "YES" values - NOT Case Sensitive
For iBookCount = 1 To iLastRow
If UCase(vaData(iBookCount, iHeading)) = "YES" Then
'"YES" value found
Let iSoldCounter = iSoldCounter + 1
ReDim Preserve vaSoldBooks(iSoldCounter)
'Load vaSoldBooks array with Sold Book's Title located
'in same row of the column(iTitleColumn)
vaSoldBooks(iSoldCounter) = vaData(iBookCount, iTitleColumn)
End If
Next iBookCount
With Worksheets("breakdown")
'Clear the column to receive the Sold Book Titles
..Columns(strSoldTitlesColumn).ClearContents
'Replace the "Sold Titles" heading
..Range(strSoldTitlesColumn & "1").Value = _
strSoldTitlesHeading
'Add the Titles of the Sold Books
..Range(strSoldTitlesColumn & "2"). _
Resize(UBound(vaSoldBooks), 1) _
..Value = WorksheetFunction.Transpose(vaSoldBooks)
..Columns(strSoldTitlesColumn).AutoFit
End With
End Sub


I have added comments to help with interpreting what I have done.

I have coded out the dependance on the relative positions of "Sold" and
"Title" headings.
The code now searches for both headings in row 1 so it doesn't matter
where they are positioned, as long as they are somewhere in row 1 and
are spelt "sold" and "title".

I haven't completely coded out the final column for the sold titles on
the breakdown sheet, but I have made it very easy for you to change it
in one fell swoop.

Look at the first two lines of code...

Const strSoldTitlesColumn As String = "A"
Const strSoldTitlesHeading As String = "Sold Titles"

the "A" results in the titles in column A on the breakdown sheet, so
all you need to do is change it to any thing from "B" up to "IV". What
could be easier?

The "Sold Titles" can also be changed to whatever you heart desires, it
determines the heading you will see at the top of the list of sold
titles.

I've also added an AutoFit line so that the Sold Titles column width
adjusts its width to accommodate the longest title.


Ken Johnson

 

[Ken Johnson]

Hi Patrick,

I forgot to answer your question re supporting named ranges. My
experience with coding with named ranges is limited so I decided to
have a go. Here's the result...

Public Sub ListSoldTitles()
'This version relies on two named ranges on the
'sheet named "extended"...
'Name = "Titles" which refers to ALL of the book titles
'Name = "Sold" which refers to list of "Yes"/"No"
'You still need to edit the value of the string constant
'strDestination at the end of the next line
Const strDestination As String = "A" '<< edit to suit
Application.ScreenUpdating = False
With Worksheets("breakdown")
.Columns(strDestination).ClearContents
'Add 'Sold Titles' heading to breakdown sheet
.Cells(1, strDestination) = "Sold Titles"
End With
Dim I As Long
Dim J As Long
Dim rgCell As Range
For Each rgCell In Worksheets("extended").Range("Sold")
I = I + 1
If UCase(rgCell.Value) = "YES" Then
J = J + 1
Worksheets("breakdown").Cells(J + 1, strDestination).Value _
= Worksheets("extended").Range("Title").Cells(I, 1).Value
End If
Next rgCell
Worksheets("breakdown").Columns(strDestination).AutoFit
End Sub

How's that for code shrinkage

WIth named ranges all the hard work is done by excel, rather than the
programmer.

I assume you are using dynamic named ranges. They certainly make life a
lot easier.

Ken Johnson