Is there an easier way to address ranges??

[dororke]

Hi,

I've created the bit of code below to copy a row of data from 3
worksheets to one worksheet so that the rows are appended to each other
and then finally sorted.

The code works fine but seems to be rather cumbersome. Is there an
easier way of addressing ranges rather than having to create/define
them first? Any advice of my use of the other fuctions would also be
greatly appreciated.

Thanks in advance,

Dan


Sub FindUniqueBSN()
'
' FindUniqueBSN Macro

Dim WS1Name As String
Dim WS2Name As String
Dim WS3Name As String

Sheets.Add.Name = "UniqueBSNList"
WS1Name = "All Open Tickets"
WS2Name = "Tickets raised this month"
WS3Name = "Tickets closed this month"

'Set up 3 ranges for each worksheet
ActiveWorkbook.Names.Add Name:="WS1BSN", RefersToR1C1:= _
"=OFFSET('" & WS1Name & "'!R4C2,0,0,COUNTA('" & WS1Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS2BSN", RefersToR1C1:= _
"=OFFSET('" & WS2Name & "'!R4C2,0,0,COUNTA('" & WS2Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS3BSN", RefersToR1C1:= _
"=OFFSET('" & WS3Name & "'!R4C2,0,0,COUNTA('" & WS3Name &
"'!C1)-2,1)"
'Copy 1st range to new worksheet
Sheets(WS1Name).Select
Range("WS1BSN").Select
Selection.Copy Sheets("UniqueBSNList").Range("B2")
'Copy 2nd range to new worksheet but at end of 1st range
Sheets(WS2Name).Select
Range("WS2BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Copy 3rd range to new worksheet but at end of both previous ranges
Sheets(WS3Name).Select
Range("WS3BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Select entire range then sort it
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R2C2,0,0,COUNTA('UniqueBSNList'!C2),1)"
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub

 

[Patrick Molloy]

It didnt' seem to clear.
The code below assumes you want to copy a table in A4:Bnn
from three sheets into a new sheet. In each of th ethree
sheets, the length of the table is not know.
The code adds a new worksheet. It then selects the range
A4:Bnn fron the first named sheets & copies it to the new
worksheet. Then, for te two other sheets, it copies
A4:Bnn to the next available row in the new worksheet.
Finally, the copied cells are sorted.

Hopefully, you'll see the purpose and will be able to
adapt it. Note that it is not necessary to select a range
in order to use it.

Option Explicit
Sub FindUniqueBSN()
'
' FindUniqueBSN Macro

Dim WSNew As Worksheet
Set WSNew = Worksheets.Add

WSNew.Name = "UniqueBSNList"

With Worksheets("All Open Tickets")
.Range(.Range("A4"), _
.Range("B4").End(xlDown)).Copy
WSNew.Range("A1").PasteSpecial _
xlPasteValues
End With

With Worksheets("Tickets raised this month")
.Range(.Range("A4"), _
.Range("B4").End(xlDown)).Copy
WSNew.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial
xlPasteValues
End With

With Worksheets("Tickets closed this month")
.Range(.Range("A4"), .Range("B4").End(xlDown)).Copy
WSNew.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial _
xlPasteValues
End With

Application.CutCopyMode = False

With WSNew
.Range(.Range("A1"), _
.Range("B1").End(xlDown)).Sort _
Key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With

End Sub

Patrick Molloy
Microsoft Excel MVP

 

[Dave Peterson]

See one more reply to your other post.

Hi,

I've created the bit of code below to copy a row of data from 3
worksheets to one worksheet so that the rows are appended to each other
and then finally sorted.

The code works fine but seems to be rather cumbersome. Is there an
easier way of addressing ranges rather than having to create/define
them first? Any advice of my use of the other fuctions would also be
greatly appreciated.

Thanks in advance,

Dan

Sub FindUniqueBSN()
'
' FindUniqueBSN Macro

Dim WS1Name As String
Dim WS2Name As String
Dim WS3Name As String

Sheets.Add.Name = "UniqueBSNList"
WS1Name = "All Open Tickets"
WS2Name = "Tickets raised this month"
WS3Name = "Tickets closed this month"

'Set up 3 ranges for each worksheet
ActiveWorkbook.Names.Add Name:="WS1BSN", RefersToR1C1:= _
"=OFFSET('" & WS1Name & "'!R4C2,0,0,COUNTA('" & WS1Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS2BSN", RefersToR1C1:= _
"=OFFSET('" & WS2Name & "'!R4C2,0,0,COUNTA('" & WS2Name &
"'!C1)-2,1)"
ActiveWorkbook.Names.Add Name:="WS3BSN", RefersToR1C1:= _
"=OFFSET('" & WS3Name & "'!R4C2,0,0,COUNTA('" & WS3Name &
"'!C1)-2,1)"
'Copy 1st range to new worksheet
Sheets(WS1Name).Select
Range("WS1BSN").Select
Selection.Copy Sheets("UniqueBSNList").Range("B2")
'Copy 2nd range to new worksheet but at end of 1st range
Sheets(WS2Name).Select
Range("WS2BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Copy 3rd range to new worksheet but at end of both previous ranges
Sheets(WS3Name).Select
Range("WS3BSN").Select
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R1C2,COUNTA('UniqueBSNList'!C2)+1,0)"
Selection.Copy Sheets("UniqueBSNList").Range("BSNLength")
'Select entire range then sort it
ActiveWorkbook.Names.Add Name:="BSNLength", RefersToR1C1:= _
"=OFFSET('UniqueBSNList'!R2C2,0,0,COUNTA('UniqueBSNList'!C2),1)"
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess
_
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub