ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Need 2 macros (https://www.excelbanter.com/excel-discussion-misc-queries/222531-need-2-macros.html)

chrisnsmith

Need 2 macros
 
I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



chrisnsmith

Need 2 macros
 
Need a third macro to sort Columns A,E and I. I need to sort them first
alphabetically beginning with row 3, and then for those accounts that are
only numbers, I need to sort them in descending order following the
alphabetical listings.

Row count for columns A,E and I =102. Rows in each columns A,E and I need to
shift up to any blank rows after deleting any R accounts.
"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



joel

Need 2 macros
 
Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



chrisnsmith

Need 2 macros
 
Joel,
Tried your macro, it worked great. Thanks

"Joel" wrote:

Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



chrisnsmith

Need 2 macros
 
Sorry Joel,
My worksheets has 6 segments. Again, all info is posted beginning in
row 3.
Each segment has the same column headers.

"Account" "Long" "Short"

Segment 1 (columns A,B,C)
Segment 2 (columns E,F,G)
Segment 3 (columns I,J,K)
Segment 4 (columns M,N,O)
Segment 5 (columns Q,R,S)
Segment 6 (columns U,V,W)

At the time I tested your macro I had actually posted info in Segment
1. After posting info in the additional segments I discovered that your
macro did not delete the R accounts
in those segments. I hope this explains my needs better.
Hope you can help.

"chrisnsmith" wrote:

Joel,
Tried your macro, it worked great. Thanks

"Joel" wrote:

Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



joel

Need 2 macros
 
Not sure why the code isn't working for you. I can see only 3 reasons

1) The code assumes the header columns are in Row 1. It uses Row one to
determine how many columns you have. Make sure there is a header column for
every segment
2) The code assumes each acount number is at every 4th column (A,E, I, M,
Q, U)
3) The code assumes there are no blanks to the left of the "R". Make sure
there isn't any other characters before the "R".


Here is the sort macro

Sub ClearRRows()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = LastRow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

Sub SortColumns()


LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For ColCount = 1 To LastCol Step 4
'First sort column descending to get letter account first
LastRow = Cells(Rows.Count, ColCount).End(xlUp).Row
Set SortRange = Range(Cells(3, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo

'find where Letter accounts stop
RowCount = 3
Do While Not IsNumeric(Cells(RowCount, ColCount))
RowCount = RowCount + 1
Loop
If RowCount 4 Then
Set SortRange = Range(Cells(3, ColCount), _
Cells(RowCount - 1, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlAscending, _
header:=xlNo
End If
If RowCount < LastRow Then
Set SortRange = Range(Cells(RowCount, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo
End If

Next ColCount
End Sub

"chrisnsmith" wrote:

Sorry Joel,
My worksheets has 6 segments. Again, all info is posted beginning in
row 3.
Each segment has the same column headers.

"Account" "Long" "Short"

Segment 1 (columns A,B,C)
Segment 2 (columns E,F,G)
Segment 3 (columns I,J,K)
Segment 4 (columns M,N,O)
Segment 5 (columns Q,R,S)
Segment 6 (columns U,V,W)

At the time I tested your macro I had actually posted info in Segment
1. After posting info in the additional segments I discovered that your
macro did not delete the R accounts
in those segments. I hope this explains my needs better.
Hope you can help.

"chrisnsmith" wrote:

Joel,
Tried your macro, it worked great. Thanks

"Joel" wrote:

Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



chrisnsmith

Need 2 macros
 
I'm not well versed in vb but I'm learning from reading the codes provided by
people in this discussionh group. I discovered the error in your code after
reading through it myself.

"LastCol = Cells(1, Columns.Count).End(xlToLeft).Column''
should have been (xlToRight)
after changing this it works great.
Thanks again

"Joel" wrote:

Not sure why the code isn't working for you. I can see only 3 reasons

1) The code assumes the header columns are in Row 1. It uses Row one to
determine how many columns you have. Make sure there is a header column for
every segment
2) The code assumes each acount number is at every 4th column (A,E, I, M,
Q, U)
3) The code assumes there are no blanks to the left of the "R". Make sure
there isn't any other characters before the "R".


Here is the sort macro

Sub ClearRRows()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = LastRow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

Sub SortColumns()


LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For ColCount = 1 To LastCol Step 4
'First sort column descending to get letter account first
LastRow = Cells(Rows.Count, ColCount).End(xlUp).Row
Set SortRange = Range(Cells(3, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo

'find where Letter accounts stop
RowCount = 3
Do While Not IsNumeric(Cells(RowCount, ColCount))
RowCount = RowCount + 1
Loop
If RowCount 4 Then
Set SortRange = Range(Cells(3, ColCount), _
Cells(RowCount - 1, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlAscending, _
header:=xlNo
End If
If RowCount < LastRow Then
Set SortRange = Range(Cells(RowCount, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo
End If

Next ColCount
End Sub

"chrisnsmith" wrote:

Sorry Joel,
My worksheets has 6 segments. Again, all info is posted beginning in
row 3.
Each segment has the same column headers.

"Account" "Long" "Short"

Segment 1 (columns A,B,C)
Segment 2 (columns E,F,G)
Segment 3 (columns I,J,K)
Segment 4 (columns M,N,O)
Segment 5 (columns Q,R,S)
Segment 6 (columns U,V,W)

At the time I tested your macro I had actually posted info in Segment
1. After posting info in the additional segments I discovered that your
macro did not delete the R accounts
in those segments. I hope this explains my needs better.
Hope you can help.

"chrisnsmith" wrote:

Joel,
Tried your macro, it worked great. Thanks

"Joel" wrote:

Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



joel

Need 2 macros
 
I'm glad the code works, but the line wasn't an error. There is something
differnt in row 1 of you worksheet that is causing a problem. No sure what.

Let me explain what my line of code did

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Columns.Count is constant which the last column of the worksheet. Normally
in excel 2003 it would be 256 which is column IV. The line of code goes to
the last column and searches to the left until it finds some data in row 1
whic is cells(row,column). if you were getting too few columns then you
didn't have headers in every column in Row 1. I suspect you had nothing in
Row 1. the your change (xlto right) would of gone to the last column 256.
the code would work but your are checking every column in the worksheet which
would take the macro a lot more time to execute. If your header row is row 2
then make this change.

from
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

to
LastCol = Cells(2, Columns.Count).End(xlToLeft).Column

"chrisnsmith" wrote:

I'm not well versed in vb but I'm learning from reading the codes provided by
people in this discussionh group. I discovered the error in your code after
reading through it myself.

"LastCol = Cells(1, Columns.Count).End(xlToLeft).Column''
should have been (xlToRight)
after changing this it works great.
Thanks again

"Joel" wrote:

Not sure why the code isn't working for you. I can see only 3 reasons

1) The code assumes the header columns are in Row 1. It uses Row one to
determine how many columns you have. Make sure there is a header column for
every segment
2) The code assumes each acount number is at every 4th column (A,E, I, M,
Q, U)
3) The code assumes there are no blanks to the left of the "R". Make sure
there isn't any other characters before the "R".


Here is the sort macro

Sub ClearRRows()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = LastRow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

Sub SortColumns()


LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For ColCount = 1 To LastCol Step 4
'First sort column descending to get letter account first
LastRow = Cells(Rows.Count, ColCount).End(xlUp).Row
Set SortRange = Range(Cells(3, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo

'find where Letter accounts stop
RowCount = 3
Do While Not IsNumeric(Cells(RowCount, ColCount))
RowCount = RowCount + 1
Loop
If RowCount 4 Then
Set SortRange = Range(Cells(3, ColCount), _
Cells(RowCount - 1, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlAscending, _
header:=xlNo
End If
If RowCount < LastRow Then
Set SortRange = Range(Cells(RowCount, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo
End If

Next ColCount
End Sub

"chrisnsmith" wrote:

Sorry Joel,
My worksheets has 6 segments. Again, all info is posted beginning in
row 3.
Each segment has the same column headers.

"Account" "Long" "Short"

Segment 1 (columns A,B,C)
Segment 2 (columns E,F,G)
Segment 3 (columns I,J,K)
Segment 4 (columns M,N,O)
Segment 5 (columns Q,R,S)
Segment 6 (columns U,V,W)

At the time I tested your macro I had actually posted info in Segment
1. After posting info in the additional segments I discovered that your
macro did not delete the R accounts
in those segments. I hope this explains my needs better.
Hope you can help.

"chrisnsmith" wrote:

Joel,
Tried your macro, it worked great. Thanks

"Joel" wrote:

Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



chrisnsmith

Need 2 macros
 
And I thought I was getting smart... You were right, after going back to my
worksheet I realized I had made a change after posting my request. The first
row with info started in row 3. So I change this line:

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
(3)
It works and is hopefully what you intended.

"Joel" wrote:

I'm glad the code works, but the line wasn't an error. There is something
differnt in row 1 of you worksheet that is causing a problem. No sure what.

Let me explain what my line of code did

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Columns.Count is constant which the last column of the worksheet. Normally
in excel 2003 it would be 256 which is column IV. The line of code goes to
the last column and searches to the left until it finds some data in row 1
whic is cells(row,column). if you were getting too few columns then you
didn't have headers in every column in Row 1. I suspect you had nothing in
Row 1. the your change (xlto right) would of gone to the last column 256.
the code would work but your are checking every column in the worksheet which
would take the macro a lot more time to execute. If your header row is row 2
then make this change.

from
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

to
LastCol = Cells(2, Columns.Count).End(xlToLeft).Column

"chrisnsmith" wrote:

I'm not well versed in vb but I'm learning from reading the codes provided by
people in this discussionh group. I discovered the error in your code after
reading through it myself.

"LastCol = Cells(1, Columns.Count).End(xlToLeft).Column''
should have been (xlToRight)
after changing this it works great.
Thanks again

"Joel" wrote:

Not sure why the code isn't working for you. I can see only 3 reasons

1) The code assumes the header columns are in Row 1. It uses Row one to
determine how many columns you have. Make sure there is a header column for
every segment
2) The code assumes each acount number is at every 4th column (A,E, I, M,
Q, U)
3) The code assumes there are no blanks to the left of the "R". Make sure
there isn't any other characters before the "R".


Here is the sort macro

Sub ClearRRows()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = LastRow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

Sub SortColumns()


LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For ColCount = 1 To LastCol Step 4
'First sort column descending to get letter account first
LastRow = Cells(Rows.Count, ColCount).End(xlUp).Row
Set SortRange = Range(Cells(3, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo

'find where Letter accounts stop
RowCount = 3
Do While Not IsNumeric(Cells(RowCount, ColCount))
RowCount = RowCount + 1
Loop
If RowCount 4 Then
Set SortRange = Range(Cells(3, ColCount), _
Cells(RowCount - 1, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlAscending, _
header:=xlNo
End If
If RowCount < LastRow Then
Set SortRange = Range(Cells(RowCount, ColCount), _
Cells(LastRow, ColCount + 2))
SortRange.Sort _
key1:=Cells(3, ColCount), _
order1:=xlDescending, _
header:=xlNo
End If

Next ColCount
End Sub

"chrisnsmith" wrote:

Sorry Joel,
My worksheets has 6 segments. Again, all info is posted beginning in
row 3.
Each segment has the same column headers.

"Account" "Long" "Short"

Segment 1 (columns A,B,C)
Segment 2 (columns E,F,G)
Segment 3 (columns I,J,K)
Segment 4 (columns M,N,O)
Segment 5 (columns Q,R,S)
Segment 6 (columns U,V,W)

At the time I tested your macro I had actually posted info in Segment
1. After posting info in the additional segments I discovered that your
macro did not delete the R accounts
in those segments. I hope this explains my needs better.
Hope you can help.

"chrisnsmith" wrote:

Joel,
Tried your macro, it worked great. Thanks

"Joel" wrote:

Sub clearrows()

Rows("3:" & Rows.Count).ClearContents

End Sub

Sub ClearRRows()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
RowCount = Lastrow
Do While RowCount = 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub





"chrisnsmith" wrote:

I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.


A B C D E F G H
I J K
1 Account Long Short Account Long Short Account Long
Short
2
3 PA037 4 PA037 4 CR237 7
4 Q1024 4 Q1024 4 PA037 4
4 Q1024 4 Q1024 4 HI012 8
5 Q2050 4 Q2050 4 R2009 5
6 Q2450 1 Q2450 1 R8912 6
7 R0000 33 R0000 33
8 R0924 4 R0924 4
9 5032 33 5032 33
10 10375 20 10375 20
11 29280 1 29280 1
12 39124 2 39124 15



curlydave

Need 2 macros
 
Try this,

Sub FindValueDeleteRow()
Dim s As String, Count As Integer
Application.ScreenUpdating = False
s = "R"
For Count = 1 To ActiveSheet.UsedRange.Rows.Count

Set f = Cells.Find(s, LookIn:=xlValues)
If Not f Is Nothing Then
f.EntireRow.Delete 'Shift:=xlUp
Application.ScreenUpdating = True
End If
Next Count
End Sub
Sub ClearRange()
Dim r As Range
Set r = Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
r.ClearContents
End Sub

Jarek Kujawa[_2_]

Need 2 macros
 
re 1. you do not need a macro
simply select the whole range
then press CTRL+H (or Edit-Replace)
in Find window insert R*
in Replace with window do not insert anything
press Replace all

if you still need a macro you may record a/m actions through Tools-
Macros-Record new macro



re 2. do you really mean an "entire workbook" or a specific worksheet?

for a specific worksheet:

Sub cus()

With ActiveCell
Range(Cells(3, 1), Cells(.SpecialCells
(xlCellTypeLastCell).Row, .SpecialCells
(xlCellTypeLastCell).Column)).ClearContents
End With

End Sub


for an "entire workbook":

Sub cus()


Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
With ActiveCell
Range(Cells(3, 1), Cells(.SpecialCells
(xlCellTypeLastCell).Row, .SpecialCells
(xlCellTypeLastCell).Column)).ClearContents
End With
Next ws


End Sub

HIH

On 27 Lut, 16:10, chrisnsmith
wrote:
I need macros to perform two operations on the following example.

1. I need to delete any Accounts in columns A,E and I that begin with R.
2. I need a macro to clear the contents of the entire workbook starting at
row 3.

* * * * A * * * * *B * * * C * * * D * * * E * * * * *F * * * * *G * * *H * *
* I * * * * *J * * * *K
1 * Account *Long *Short * * * *Account * Long * *Short * * * Account *Long *
Short * * *
2 * * * * * * * * * * * * * * * * * * * * * * * * * * *
3 * PA037 * * * * * * 4 * * * * * * PA037 * * * * * * *4 * * * * * *CR237 * * 7
4 * Q1024 * * * * * * 4 * * * * * * Q1024 * * * * * * *4 * * * * * *PA037 * * * * * * * * * 4 *
4 * Q1024 * * * * * * 4 * * * * * * Q1024 * * * * * * *4 * * * * * *HI012 * * *8 *
5 * Q2050 * * * * * * 4 * * * * * * Q2050 * * * * * * *4 * * * * * *R2009 * * * * * * * 5 *
6 * Q2450 * * * * * * 1 * * * * * * Q2450 * * *1 * * * * * * * * * * * * * *R8912 * * *6
7 * R0000 * * * * * *33 * * * * * * R0000 * * * * * * * * 33 * * * *
8 * R0924 * * * * * * 4 * * * * * * R0924 * * * * * * * 4 * * * * *
9 * * 5032 * * * * * 33 * * * * * * * 5032 * * 33 * * * * * * * * *
10 *10375 * * * * * *20 * * * * * * 10375 * * * * * * 20 * * * * * *
11 *29280 * * * * * * 1 * * * * * * 29280 * * * * * * * * *1 * * * *
12 *39124 * * * * * * 2 * * * * * * 39124 * * *15



curlydave

Need 2 macros
 
What happened with the first two code I gave you?

curlydave

Need 2 macros
 
On Mar 1, 7:59*am, CurlyDave wrote:
Try this,

Sub FindValueDeleteRow()
* * Dim s As String, Count As Integer
* * Application.ScreenUpdating = False
* * s = "R"
* * For Count = 1 To ActiveSheet.UsedRange.Rows.Count

* * * * Set f = Cells.Find(s, LookIn:=xlValues)
* * * * If Not f Is Nothing Then
* * * * * * f.EntireRow.Delete * *'Shift:=xlUp
* * * * * * Application.ScreenUpdating = True
* * * * End If
* * Next Count
End Sub
Sub ClearRange()
* * Dim r As Range
* * Set r = Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
* * r.ClearContents
End Sub


Change

f.EntireRow.Delete 'Shift:=xlUp

f=""
To just clear the contents

chrisnsmith

Need 2 macros
 
CurlyDave,
I need you to refine your code. At present when I run the macro it
deletes everything above row six. I need to keep these rows because they
contain text info.
I'm attaching an example of my worksheet.

A B C D E
1 Company Name Date
2 Other Info
3 "
4 "
5 ACCT COMM STRIKE LONG SHORT
6 Data begins here.
7
8
9
10
11
12
13
14
15

"CurlyDave" wrote:

On Mar 1, 7:59 am, CurlyDave wrote:
Try this,

Sub FindValueDeleteRow()
Dim s As String, Count As Integer
Application.ScreenUpdating = False
s = "R"
For Count = 1 To ActiveSheet.UsedRange.Rows.Count

Set f = Cells.Find(s, LookIn:=xlValues)
If Not f Is Nothing Then
f.EntireRow.Delete 'Shift:=xlUp
Application.ScreenUpdating = True
End If
Next Count
End Sub
Sub ClearRange()
Dim r As Range
Set r = Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
r.ClearContents
End Sub


Change

f.EntireRow.Delete 'Shift:=xlUp

f=""
To just clear the contents


curlydave

Need 2 macros
 
.........2. I need a macro to clear the contents of the entire workbook
starting at
row 3. ...........
Adjust the code to suite your requirements....


All times are GMT +1. The time now is 12:45 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com