currentregion

[Guest]

I want a macro..
that will select a currentregion (starting from A1) and pasting in new sheet

but after pasting.. I want to color the first row and the last row.

The number of row varies..

How canI do it?

 

[Bob Phillips]

Dim rng As Range

ActiveSheet.Range("A1").CurrentRegion.Copy
With Worksheets("Sheet2")
.Activate
.Range("A1").Select
.Paste
Set rng = .Range("A1").CurrentRegion
rng.Cells(1, 1).EntireRow.Interior.ColorIndex = 38
rng(rng.Count).EntireRow.Interior.ColorIndex = 38
End With


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Guest]

thanks
it works

but it colours the entire row (first and last)

and not just the selection

helps

 

[Dave Peterson]

Dim rng As Range
ActiveSheet.Range("A1").CurrentRegion.Copy
With Worksheets("Sheet2")
.Activate
.Range("A1").Select
.Paste
Set rng = .Range("A1").CurrentRegion
rng.Cells(1, 1).resize(1,rng.columns.count).Interior.ColorIndex = 38
rng(rng.Count).EntireRow.resize(1,rng.columns.count) _
.Interior.ColorIndex = 38
End With

 

[Guest]

thanks

But when I paste it in the new sheet at "C20"

It highlights the first row correctly.. but the last row highlight starts
with A20 instead of C20

Also can I add a condition...

If column A... contains word "total".. highlight that enire row?

 

[Dave Peterson]

How about this:

Option Explicit
Sub testme01()

Dim rng As Range
Dim DestCell As Range

With Worksheets("sheet1")
Set rng = .Range("A1").CurrentRegion
End With

With Worksheets("sheet2")
Set DestCell = .Range("C20")
End With

rng.Copy _
Destination:=DestCell

DestCell.Resize(1, rng.Columns.Count).Interior.ColorIndex = 38
DestCell.Offset(rng.Rows.Count - 1, 0).Resize(1, rng.Columns.Count) _
.Interior.ColorIndex = 38

End Sub

 

[Guest]

Many thanks it works perfect

Also can we add another conidition to it

IF cell a of the current region contains "Total".. highlight the enitre row?

 

[Bob Phillips]

Tack this on at the end

Dim cell As Range
For Each cell In DestCell.CurrentRegion
If cell.Value = "Total" Then
cell.EntireRow.Interior.ColorIndex = 38
End If
Next cell


--

HTH

RP
(remove nothere from the email address if mailing direct)

Many thanks it works perfect

Also can we add another conidition to it

IF cell a of the current region contains "Total".. highlight the enitre row?

 

[Guest]

Thanks

a small glitch though

The cell contains not only the work Total but maybe "aa45 Total" or various
other options

Can we use wild character?

 

[Bob Phillips]

Dim cell As Range
For Each cell In DestCell.CurrentRegion
If cell.Value Like "*Total*" Then
cell.EntireRow.Interior.ColorIndex = 38
End If
Next cell

--

HTH

RP
(remove nothere from the email address if mailing direct)

Thanks

a small glitch though

The cell contains not only the work Total but maybe "aa45 Total" or various
other options

Can we use wild character?

 

[Guest]

thanks it works now
but it still highlights from column A.. where as the currentregions tstarts
from column c

 

[Dave Peterson]

Option Explicit
Sub testme01()

Dim rng As Range
Dim DestCell As Range
Dim cell As Range

With Worksheets("sheet1")
Set rng = .Range("A1").CurrentRegion
End With

With Worksheets("sheet2")
Set DestCell = .Range("C20")
End With

rng.Copy _
Destination:=DestCell

DestCell.Resize(1, rng.Columns.Count).Interior.ColorIndex = 38
DestCell.Offset(rng.Rows.Count - 1, 0).Resize(1, rng.Columns.Count) _
.Interior.ColorIndex = 38

For Each cell In DestCell.CurrentRegion
If LCase(cell.Value) Like LCase("*Total*") Then
Intersect(DestCell.CurrentRegion, cell.EntireRow) _
.Interior.ColorIndex = 38
End If
Next cell

End Sub

 

[Bob Phillips]

You asked for the entirerow!

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Dave Peterson]

multiple times
<vvbg>

You asked for the entirerow!

--

HTH

RP
(remove nothere from the email address if mailing direct)