[mso] Re: Excel VBA Code
- From: Thomas Hutchins <hutch99999@xxxxxxxxx>
- To: mso@xxxxxxxxxxxxx
- Date: Thu, 12 Nov 2009 15:41:50 -0800 (PST)
Hi Herbert,
Try this macro. Select the cell in column A of the first row of data before
running it.
Sub MakeIndexPage()
Dim x As Integer, CurrItem As String
Dim StartRow As Long, CurrRow As Long, FinalRow As Long
'!!! active cell must be in column A in first row of data !!!
StartRow = ActiveCell.Row
Do While Len(ActiveCell.Value) > 0
CurrRow = ActiveCell.Row
CurrItem = ActiveCell.Value
'insert 42 rows below the current row
Range("A" & CurrRow + 1 & ":A" & CurrRow + 42).Select
Selection.EntireRow.Insert
'fill the new cells in column A with the current item
Range("A" & CurrRow + 1 & ":A" & CurrRow + 42).Value = CurrItem
'copy columns C-AR in the current row. paste as values & transpose
'in new rows in column B
Range("C" & CurrRow & ":AR" & CurrRow).Select
Selection.Copy
Range("B" & CurrRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
'move to the next item
Range("A" & CurrRow + 43).Activate
Loop
FinalRow = ActiveCell.Row - 1
'sort the data by ascending column B.
Range("A" & StartRow & ":AR" & FinalRow).Sort Key1:=Columns("B"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:úlse, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortTextAsNumbers
'delete rows with no page numbers in column B
CurrRow = Range("B" & StartRow).End(xlDown).Row + 1
Range("B" & CurrRow & ":B" & FinalRow).EntireRow.Delete
'sort the data by ascending column A, then B.
FinalRow = CurrRow - 1
Range("A" & StartRow & ":AR" & FinalRow).Sort Key1:=Columns("A"), _
Order1:=xlAscending, Key2:=Columns("B"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:úlse, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortTextAsNumbers
'delete columns C-AR
Columns("C:AR").Delete Shift:=xlToLeft
Range("A3").Select
End Sub
Hope this helps,
Hutch
--- On Wed, 11/4/09, Herbert Chitate <herbertc@xxxxxxxxx> wrote:
From: Herbert Chitate <herbertc@xxxxxxxxx>
Subject: [mso] Excel VBA Code
To: mso@xxxxxxxxxxxxx
Date: Wednesday, November 4, 2009, 6:05 AM
Hi All,
I have a magazine indexing spreadsheet that I am trying to sort and was
wondering if one of you good folks could help me with the code to part
automate this process.
To visualise this, think about the index page at the back of a book or
magazine.
In Column A, I have the description of the item.
In Column B, I have the first page number that that item is on.
In columns C to AR I have any other page that this item is also on.
From this, I need to come up with a list with columns A & B only.
* I therefore looking for a vba code that will insert 41 rows (for
contents of c to ar)
* copy the contents of cells along column c to ar vertically in column b
* go to the next item in column a and repeat this process, until the
whole worksheet is complete (file has 1300 rows)
Any help that I can get will be much appreciated.
Thanks
Herbert
______________________________________________________________________
This e-mail, plus any files attached, may be confidential and is intended
solely for the addressee. Please contact the sender if you have received this
message in error. We recommend that recipients virus check all e-mails and
files received
As a public sector Organisation, YPO may be required to disclose this email [or
any response to it] under the Freedom of Information Act 2000, unless the
information in it is covered by one of the exemptions in the Act.
For the full disclaimer please access http://www.ypo.co.uk/e-maild
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, visit the group's homepage and use the dropdown
menu at the top. This will allow you to unsubscribe your email address or
change your email settings to digest or vacation (no mail).
//www.freelists.org/webpage/mso
To be able to share files with the group, you must join our Yahoo sister
group. This group will not allow for posting of emails, but will allow you to
join and share problem files, templates, etc.:
http://tech.groups.yahoo.com/group/MicrosoftOffice . This group is for FILE
SHARING ONLY.
If you are using Outlook and you see a lot of unnecessary code in your email
messages, read these instructions that explain why and how to fix it:
http://personal-computer-tutor.com/abc3/v28/greg28.htm
*************************************************************
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, visit the group's homepage and use the dropdown
menu at the top. This will allow you to unsubscribe your email address or
change your email settings to digest or vacation (no mail).
//www.freelists.org/webpage/mso
To be able to share files with the group, you must join our Yahoo sister group.
This group will not allow for posting of emails, but will allow you to join
and share problem files, templates, etc.:
http://tech.groups.yahoo.com/group/MicrosoftOffice . This group is for FILE
SHARING ONLY.
If you are using Outlook and you see a lot of unnecessary code in your email
messages, read these instructions that explain why and how to fix it:
http://personal-computer-tutor.com/abc3/v28/greg28.htm
*************************************************************
Other related posts:
