Macro Help

G

Guest

Could someone please create a macro to help me with a spreedsheet. I
understand the verbal steps but I cannot write code.

I start out by pasting a region of cells in cell A1. Row 1 are column
headings. I would like a macro to do the following steps for me:

Delete Rows Labeled:
Alpha Sequence
Administrator
Admin #
Investment Officer
Inv Officer #
Real Estate Officer
R.E. Officer #
Tax Officer
Tax Officer #

Then I would like to sorta the entire region of cells by the row labeled
"Rel. Code" in ascending order.

This is now where it gets tricky. Each row has a relationship code number.
Anywhere from just 1 row, to 50 rows could have the same relationship number.
I would like insert a row at the bottom of each group of relationship codes
with the sum of the data in the column labeled "Market Value" in bold.
Following each sum, I would like a blank row.

Once this is complete, please sort each group by their total market value in
descending order.


Thank you, I greatly appreciate any efforts.
 
G

Guest

I need more information before I complete the coding. I'm confused by your
instructions. See Comments below


Could someone please create a macro to help me with a spreedsheet. I
understand the verbal steps but I cannot write code.

I start out by pasting a region of cells in cell A1. Row 1 are column
headings. I would like a macro to do the following steps for me:


1) Are these lebels in Column A? Or do you mean to delte Columns not rows?
Delete Rows Labeled:
Alpha Sequence
Administrator
Admin #
Investment Officer
Inv Officer #
Real Estate Officer
R.E. Officer #
Tax Officer
Tax Officer #

2) Again, Is Rel.Code a row or column?
Then I would like to sorta the entire region of cells by the row labeled
"Rel. Code" in ascending order.

3) Which column is the Relationship code number? Is I'm sorting in "2"
above then I assume the column will change. Then I need the exact heading in
row 1 of this column
This is now where it gets tricky. Each row has a relationship code number.
Anywhere from just 1 row, to 50 rows could have the same relationship number.
I would like insert a row at the bottom of each group of relationship codes
with the sum of the data in the column labeled "Market Value" in bold.
Following each sum, I would like a blank row.

4) Do you mean each row within a group gets sorted, or do you mean the
Groups (from 1 to 50 rows) get swapped.
Once this is complete, please sort each group by their total market value in
descending order.


Thank you, I greatly appreciate any efforts.
 
G

Guest

1) The labels headers are in row 1. The exact cells of the headers are A1
- R1.

2) Rel. Code is in column C. Rel. Code will always be in column C since
all of the columns that will be deleted are in columns D - R.


3) Relationship code number are the data numbers within Column C labeled
which is "Rel. Code".

4) The groups will be created after sorting column C in ascending order.
For example Group 1 could be cells C2 - C5 all having relationship code
number 1000. I would like the market value of those each three summed and
inserted a new row with a value in bold in cell C6. The market value in C6
could then be say $1,000,000. Following row 6 would be an inserted blank
row 7. Then C8 would a different relaionship code number, ie. relationship
code # 1001. Cells C8-C50 could all have relationship code number 1001 and
consist of Group 2. Following in C51 would be the sum of the market values.
ie $50,000,000 and a blank row in row 52. This process would continue on
until all groups have been made. Once this is complete, I would like the
groups sorted in descending order so group 2 (market value of $50,000,000)
would be sorted ahead of group 1 (market value of $1,000,000).

I hope this makes sense. Please let me know if you need more clarification.

thanks again!
 
G

Guest

Let me know if this works

Sub fixworksheet()

'Delete unused rows
ColCount = 1
Do While Cells(1, ColCount) <> ""

Heading = Cells(1, ColCount)
Select Case Heading

Case "Alpha Sequence", _
"Administrator", _
"Admin #", _
"Investment Officer", _
"Inv Officer #", _
"Real Estate Officer", _
"R.E. Officer #", _
"Tax Officer", _
"Tax Officer #"

Columns(ColCount).Delete
Case Else
ColCount = ColCount + 1
End Select
Loop

'Sort data by Rel. code Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set SortRange = Range("A2", Cells(LastRow, LastCol))

SortRange.Sort _
Key1:=Range("C2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
MatchCase:=False, _
Orientation:=xlTopToBottom


'Insert totals
'Plase total in first empty column where each group starts
firstcol = LastCol + 1
'Place total in 2nd empty column where each group ends
totalcol = LastCol + 2
RowCount = 2
FirstRow = RowCount
Do While Cells(RowCount, "A") <> ""
If Cells(RowCount, "C") <> _
Cells(RowCount + 1, "C") Then

Rows(RowCount + 1).Insert
Cells(RowCount + 1, "C").Formula = _
"=Sum(C" & FirstRow & ":C" & RowCount & ")"
Cells(FirstRow, firstcol) = _
Cells(RowCount + 1, "C").Value
Cells(RowCount + 1, totalcol) = _
Cells(RowCount + 1, "C").Value
RowCount = RowCount + 2
FirstRow = RowCount
Else
RowCount = RowCount + 1
End If
Loop

'sort Groups
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
RowCount = 2
Do While RowCount <= LastRow
If Cells(RowCount, firstcol) <> "" Then
TotalA = Cells(RowCount, firstcol)
'get beginning of next group
CompareRow = RowCount + 1
Do While (CompareRow <= LastRow)
Do While _
(Cells(CompareRow, firstcol) = "") And _
(CompareRow <= LastRow)

CompareRow = CompareRow + 1
Loop
If CompareRow <= LastRow Then
TotalB = Cells(CompareRow, firstcol)
'if TotalB > totalA than insert
'2nd group in front of first group
If TotalB > TotalA Then
EndRow = CompareRow
Do While Cells(EndRow, totalcol) = ""
EndRow = EndRow + 1
Loop

Rows(CompareRow & ":" & EndRow).Cut
Rows(RowCount).Insert Shift:=xlDown
TotalA = TotalB
CompareRow = RowCount + 1
Else
CompareRow = CompareRow + 1
End If
End If
Loop
End If
RowCount = RowCount + 1
Loop

'add blank rows
RowCount = LastRow
Do While RowCount >= 1
If Cells(RowCount, firstcol) <> "" Then
If RowCount <> 2 Then
Rows(RowCount).Insert
End If
End If
RowCount = RowCount - 1
Loop
'delete auxilary columns added for running this maacro
Columns(totalcol).Delete
Columns(firstcol).Delete

End Sub
 
G

Guest

This works great except it summed column C which is labeled "Rel. Code". I
would like it to sum column F labeled "Market Value" instead. Once it sums
each group by market value, then please make it sorta by market value in
descending order.

The group separation and the rows that were deleted were perfect though.
Thanks for the help Joel.

Curt
 
G

Guest

I made the changes but I didn't test the code. Can you run it for me and let
me know if it works.

Sub fixworksheet()

'Delete unused rows
ColCount = 1
Do While Cells(1, ColCount) <> ""

Heading = Cells(1, ColCount)
Select Case Heading

Case "Alpha Sequence", _
"Administrator", _
"Admin #", _
"Investment Officer", _
"Inv Officer #", _
"Real Estate Officer", _
"R.E. Officer #", _
"Tax Officer", _
"Tax Officer #"

Columns(ColCount).Delete
Case Else
ColCount = ColCount + 1
End Select
Loop

'Sort data by Rel. code Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set SortRange = Range("A2", Cells(LastRow, LastCol))

SortRange.Sort _
Key1:=Range("C2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
MatchCase:=False, _
Orientation:=xlTopToBottom

'Find Market Value column
Set Market = Rows(1).Find(what:="Market Value", LookIn:=xlValues)
MarketCol = Market.Column
'Insert totals
'Plase total in first empty column where each group starts
firstcol = LastCol + 1
'Place total in 2nd empty column where each group ends
totalcol = LastCol + 2
RowCount = 2
FirstRow = RowCount
Do While Cells(RowCount, "A") <> ""
If Cells(RowCount, MarketCol) <> _
Cells(RowCount + 1, MarketCol) Then

Rows(RowCount + 1).Insert
Cells(RowCount + 1, MarketCol).FormulaR1C1 = _
"=Sum(R" & FirstRow & "C" & MarketCol & ":R" & _
RowCount & "C" & MarketCol & ")"
Cells(FirstRow, firstcol) = _
Cells(RowCount + 1, MarketCol).Value
Cells(RowCount + 1, totalcol) = _
Cells(RowCount + 1, MarketCol).Value
RowCount = RowCount + 2
FirstRow = RowCount
Else
RowCount = RowCount + 1
End If
Loop

'sort Groups
LastRow = Cells(Rows.Count, MarketCol).End(xlUp).Row
RowCount = 2
Do While RowCount <= LastRow
If Cells(RowCount, firstcol) <> "" Then
TotalA = Cells(RowCount, firstcol)
'get beginning of next group
CompareRow = RowCount + 1
Do While (CompareRow <= LastRow)
Do While _
(Cells(CompareRow, firstcol) = "") And _
(CompareRow <= LastRow)

CompareRow = CompareRow + 1
Loop
If CompareRow <= LastRow Then
TotalB = Cells(CompareRow, firstcol)
'if TotalB > totalA than insert
'2nd group in front of first group
If TotalB > TotalA Then
EndRow = CompareRow
Do While Cells(EndRow, totalcol) = ""
EndRow = EndRow + 1
Loop

Rows(CompareRow & ":" & EndRow).Cut
Rows(RowCount).Insert Shift:=xlDown
TotalA = TotalB
CompareRow = RowCount + 1
Else
CompareRow = CompareRow + 1
End If
End If
Loop
End If
RowCount = RowCount + 1
Loop

'add blank rows
RowCount = LastRow
Do While RowCount >= 1
If Cells(RowCount, firstcol) <> "" Then
If RowCount <> 2 Then
Rows(RowCount).Insert
End If
End If
RowCount = RowCount - 1
Loop
'delete auxilary columns added for running this maacro
Columns(totalcol).Delete
Columns(firstcol).Delete

End Sub
 
G

Guest

I fixed the problem and also add the total in bold which I previously forgot
to do. this should be perfect.


Sub fixworksheet()

'Delete unused rows
ColCount = 1
Do While Cells(1, ColCount) <> ""

Heading = Cells(1, ColCount)
Select Case Heading

Case "Alpha Sequence", _
"Administrator", _
"Admin #", _
"Investment Officer", _
"Inv Officer #", _
"Real Estate Officer", _
"R.E. Officer #", _
"Tax Officer", _
"Tax Officer #"

Columns(ColCount).Delete
Case Else
ColCount = ColCount + 1
End Select
Loop

'Sort data by Rel. code Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set SortRange = Range("A2", Cells(LastRow, LastCol))

SortRange.Sort _
Key1:=Range("C2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
MatchCase:=False, _
Orientation:=xlTopToBottom

'Find Market Value column
Set Market = Rows(1).Find(what:="Market Value", LookIn:=xlValues)
MarketCol = Market.Column
'Insert totals
'Plase total in first empty column where each group starts
firstcol = LastCol + 1
'Place total in 2nd empty column where each group ends
totalcol = LastCol + 2
RowCount = 2
FirstRow = RowCount
Do While Cells(RowCount, "A") <> ""
If Cells(RowCount, "C") <> _
Cells(RowCount + 1, "C") Then

Rows(RowCount + 1).Insert
Cells(RowCount + 1, MarketCol).FormulaR1C1 = _
"=Sum(R" & FirstRow & "C" & MarketCol & ":R" & _
RowCount & "C" & MarketCol & ")"
Cells(RowCount + 1, MarketCol).Font.Bold = True
Cells(FirstRow, firstcol) = _
Cells(RowCount + 1, MarketCol).Value
Cells(RowCount + 1, totalcol) = _
Cells(RowCount + 1, MarketCol).Value
RowCount = RowCount + 2
FirstRow = RowCount
Else
RowCount = RowCount + 1
End If
Loop

'sort Groups
LastRow = Cells(Rows.Count, MarketCol).End(xlUp).Row
RowCount = 2
Do While RowCount <= LastRow
If Cells(RowCount, firstcol) <> "" Then
TotalA = Cells(RowCount, firstcol)
'get beginning of next group
CompareRow = RowCount + 1
Do While (CompareRow <= LastRow)
Do While _
(Cells(CompareRow, firstcol) = "") And _
(CompareRow <= LastRow)

CompareRow = CompareRow + 1
Loop
If CompareRow <= LastRow Then
TotalB = Cells(CompareRow, firstcol)
'if TotalB > totalA than insert
'2nd group in front of first group
If TotalB > TotalA Then
EndRow = CompareRow
Do While Cells(EndRow, totalcol) = ""
EndRow = EndRow + 1
Loop

Rows(CompareRow & ":" & EndRow).Cut
Rows(RowCount).Insert Shift:=xlDown
TotalA = TotalB
CompareRow = RowCount + 1
Else
CompareRow = CompareRow + 1
End If
End If
Loop
End If
RowCount = RowCount + 1
Loop

'add blank rows
RowCount = LastRow
Do While RowCount >= 1
If Cells(RowCount, firstcol) <> "" Then
If RowCount <> 2 Then
Rows(RowCount).Insert
End If
End If
RowCount = RowCount - 1
Loop
'delete auxilary columns added for running this maacro
Columns(totalcol).Delete
Columns(firstcol).Delete

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Formula Help 10
Opening files - macro 2
File Path - Macro 1
Excel 2013 Merge Data 2
Check for duplicate records 3
Macro That doesn't work - Please help 3
Opening Files - Macro 1
Help! Can’t debug macro used to delete duplicate rows 2

Top