Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Acronym Macro 2
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
MSE MSE is offline
external usenet poster
  
Posts: 15
Default Acronym Macro 2
I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Acronym Macro 2
The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
MSE MSE is offline
external usenet poster
  
Posts: 15
Default Acronym Macro 2
Its nice to hear from you again Joel. After I try to run the Marco Excel
jumps to Visual Basic and I am getting a message that reads "compile error
argument not optional".

This part of the code -- Sub Sort_Acronyms() -- turns yellow and has an
arrow pointing next to it.

Then the word "Left" in this part of the code -- Left(.Range("F" &
(RowCount + 1), 4)) Then -- gets highlighted in blue. (I am wondering if
that is an indicator that this part of the code is having an issue)

I assigned the code you advised below to an Excel button from the forms
toolbar.

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1), 4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Do you have any thoughts?



"Joel" wrote:

The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Acronym Macro 2
I had a parenthsis in the wrong place in this line

If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

"MSE" wrote:

Its nice to hear from you again Joel. After I try to run the Marco Excel
jumps to Visual Basic and I am getting a message that reads "compile error
argument not optional".

This part of the code -- Sub Sort_Acronyms() -- turns yellow and has an
arrow pointing next to it.

Then the word "Left" in this part of the code -- Left(.Range("F" &
(RowCount + 1), 4)) Then -- gets highlighted in blue. (I am wondering if
that is an indicator that this part of the code is having an issue)

I assigned the code you advised below to an Excel button from the forms
toolbar.

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1), 4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Do you have any thoughts?



"Joel" wrote:

The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
MSE MSE is offline
external usenet poster
  
Posts: 15
Default Acronym Macro 2
Joel, you are the man! I am so grateful for your help. The code works
beautifully. There is still one more function, I am not sure if I
communicated clearly, that I am trying to add. I want to copy cells A1
through L1 on Sheet1 and paste them in cells A1 through L1 of each new
worksheet that gets created for the AAAAs, BBBBs, CCCCs, DDDDs, and so on.
Might you be able to help me with that as well?

"Joel" wrote:

I had a parenthsis in the wrong place in this line

If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

"MSE" wrote:

Its nice to hear from you again Joel. After I try to run the Marco Excel
jumps to Visual Basic and I am getting a message that reads "compile error
argument not optional".

This part of the code -- Sub Sort_Acronyms() -- turns yellow and has an
arrow pointing next to it.

Then the word "Left" in this part of the code -- Left(.Range("F" &
(RowCount + 1), 4)) Then -- gets highlighted in blue. (I am wondering if
that is an indicator that this part of the code is having an issue)

I assigned the code you advised below to an Excel button from the forms
toolbar.

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1), 4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Do you have any thoughts?



"Joel" wrote:

The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
MSE MSE is offline
external usenet poster
  
Posts: 15
Default Acronym Macro 2
Sorry, I just realized that I forgot to include the present code.

Sincerely,

Eddie

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub




"MSE" wrote:

Joel, you are the man! I am so grateful for your help. The code works
beautifully. There is still one more function, I am not sure if I
communicated clearly, that I am trying to add. I want to copy cells A1
through L1 on Sheet1 and paste them in cells A1 through L1 of each new
worksheet that gets created for the AAAAs, BBBBs, CCCCs, DDDDs, and so on.
Might you be able to help me with that as well?

"Joel" wrote:

I had a parenthsis in the wrong place in this line

If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

"MSE" wrote:

Its nice to hear from you again Joel. After I try to run the Marco Excel
jumps to Visual Basic and I am getting a message that reads "compile error
argument not optional".

This part of the code -- Sub Sort_Acronyms() -- turns yellow and has an
arrow pointing next to it.

Then the word "Left" in this part of the code -- Left(.Range("F" &
(RowCount + 1), 4)) Then -- gets highlighted in blue. (I am wondering if
that is an indicator that this part of the code is having an issue)

I assigned the code you advised below to an Excel button from the forms
toolbar.

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1), 4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Do you have any thoughts?



"Joel" wrote:

The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Acronym Macro 2
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
Sheets("Sheet1").Range("A1:L1").Copy _
Destination:=NewSht.Range("A1")
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(2)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub
"MSE" wrote:

Sorry, I just realized that I forgot to include the present code.

Sincerely,

Eddie

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub




"MSE" wrote:

Joel, you are the man! I am so grateful for your help. The code works
beautifully. There is still one more function, I am not sure if I
communicated clearly, that I am trying to add. I want to copy cells A1
through L1 on Sheet1 and paste them in cells A1 through L1 of each new
worksheet that gets created for the AAAAs, BBBBs, CCCCs, DDDDs, and so on.
Might you be able to help me with that as well?

"Joel" wrote:

I had a parenthsis in the wrong place in this line

If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

"MSE" wrote:

Its nice to hear from you again Joel. After I try to run the Marco Excel
jumps to Visual Basic and I am getting a message that reads "compile error
argument not optional".

This part of the code -- Sub Sort_Acronyms() -- turns yellow and has an
arrow pointing next to it.

Then the word "Left" in this part of the code -- Left(.Range("F" &
(RowCount + 1), 4)) Then -- gets highlighted in blue. (I am wondering if
that is an indicator that this part of the code is having an issue)

I assigned the code you advised below to an Excel button from the forms
toolbar.

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1), 4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Do you have any thoughts?



"Joel" wrote:

The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
MSE MSE is offline
external usenet poster
  
Posts: 15
Default Acronym Macro 2
Thank you. The code is perfect. I hope I have successfully communicated how
much I have appreciated your help.

"Joel" wrote:

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
Sheets("Sheet1").Range("A1:L1").Copy _
Destination:=NewSht.Range("A1")
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(2)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub
"MSE" wrote:

Sorry, I just realized that I forgot to include the present code.

Sincerely,

Eddie

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub




"MSE" wrote:

Joel, you are the man! I am so grateful for your help. The code works
beautifully. There is still one more function, I am not sure if I
communicated clearly, that I am trying to add. I want to copy cells A1
through L1 on Sheet1 and paste them in cells A1 through L1 of each new
worksheet that gets created for the AAAAs, BBBBs, CCCCs, DDDDs, and so on.
Might you be able to help me with that as well?

"Joel" wrote:

I had a parenthsis in the wrong place in this line

If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1)), 4) Then

"MSE" wrote:

Its nice to hear from you again Joel. After I try to run the Marco Excel
jumps to Visual Basic and I am getting a message that reads "compile error
argument not optional".

This part of the code -- Sub Sort_Acronyms() -- turns yellow and has an
arrow pointing next to it.

Then the word "Left" in this part of the code -- Left(.Range("F" &
(RowCount + 1), 4)) Then -- gets highlighted in blue. (I am wondering if
that is an indicator that this part of the code is having an issue)

I assigned the code you advised below to an Excel button from the forms
toolbar.

Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If Left(.Range("F" & RowCount), 4) < _
Left(.Range("F" & (RowCount + 1), 4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Left(.Range("F" & RowCount), 4)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Do you have any thoughts?



"Joel" wrote:

The code requires two minor changes

from
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
to
If left(.Range("F" & RowCount),4) < _
left(.Range("F" & (RowCount + 1),4)) Then

Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = left(.Range("F" & RowCount),4)

"MSE" wrote:

I have a Macro linked to an Excel button from the forms toolbar, thanks Joel.
The code is at the bottom of this post and it already performs the following
functions.

1. Copies the entire contents of rows in Sheet 1 from A2 to L30.

2. Sort all the contents of rows 2 through 30 based on the acronyms AAAA,
BBBB, CCCC, DDDD, & EEEE and group the AAAA with the AAAA, the BBBB with
the BBBB, and so on. (The acronyms are located in Column F rows F2
through F30).

3. Create and name a new worksheet for all the AAAA, BBBB, CCCC, DDDD, &
EEEE.

4. Paste all the contents of rows A through L containing AAAA in Sheet
AAAA, all the contents of the rows A through L containing BBBB in Sheet
BBBB, all the contents of rows A through L containing CCCC in Sheet CCCC,
and so on.

Now, I am trying to add the following functions to the code.

1. Sort all the contents of rows 2 through 30 based on the first four
letters of each acronym in Column F and then group them together. As a
result AAAA1 will be grouped with AAAA2, AAAA3, & AAAA4 on the same
worksheet and that worksheet will be named AAAA. BBBB1 will be grouped
with BBBB2,BBBB3, & BBBB4 on the same worksheet and that worksheet will
be named BBBB. CCCC1 will be grouped with CCCC2, CCCC3, and CCCC4 on the
same worksheet and that worksheet will be named CCCC and so on.

2. Copy and paste cells A1 through L1 from Sheet 1 into cells A1 through L1

of each new worksheet that is created for all the AAAAs,
BBBBs, CCCCs, and so on.

Do you have any ideas about how I might be able to make this happen?

Original Code is as follows, much thanks to Joel.
Sub Sort_Acronyms()

With Sheets("Sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L30").Sort _
Key1:=Range("F1"), _
Header:=xlNo

RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With


End Sub

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Create Acronym (Extract first letter of each word) VB_Sam Excel Worksheet Functions 20 April 24th 23 09:05 PM
Removing Of/And/The from Acronym Function msnyc07 Excel Worksheet Functions 0 March 11th 10 11:16 PM
Acronym Function? msnyc07 Excel Worksheet Functions 2 March 11th 10 09:15 PM
ACRONYM OF CAPS ONLY FARAZ QURESHI Excel Discussion (Misc queries) 3 February 23rd 09 09:58 AM
Acronym Macro MSE Excel Programming 11 June 8th 08 09:18 PM


All times are GMT +1. The time now is 07:52 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement