Find first non-empty cell ranght from column A
 

Hi There,

Could anyone help me with the following?
If a cell in Column A form my Usedrange (supposing that Usedrange
starts in Column A) is empty I would like to copy the first non-blank
cell from that row into column A.

E.g.
A B C
1 Y Y Y
2 - - Z
3 - K -

Should become:
YYY
Z-Z
KK-

Hope this makes sense,
Sige

Find first non-empty cell ranght from column A
 

Hi Sige,

Try:

'=============
Public Sub Tester()
Dim rng As Range
Dim rng2 As Range
Dim rcell As Range

On Error Resume Next
Set rng = Intersect(ActiveSheet.UsedRange, Columns("A"))
Set rng2 = rng.SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng2 Is Nothing Then
For Each rcell In rng2.Cells
With rcell
.Resize(1, 2) = .End(xlToRight).Value
End With
Next rcell
End If

End Sub
'<<=============


---
Regards,
Norman



"Sige" wrote in message
oups.com...
Hi There,

Could anyone help me with the following?
If a cell in Column A form my Usedrange (supposing that Usedrange
starts in Column A) is empty I would like to copy the first non-blank
cell from that row into column A.

E.g.
A B C
1 Y Y Y
2 - - Z
3 - K -

Should become:
YYY
Z-Z
KK-

Hope this makes sense,
Sige

Find first non-empty cell ranght from column A
 

Hi Sige,

Looking again at your example data, change:

.Resize(1, 2) = .End(xlToRight).Value

to:

.Value = .End(xlToRight).Value

---
Regards,
Norman

Find first non-empty cell ranght from column A
 

Hi Norman,

Thanks again.
It does exactly what it should!
No enhancements needed ... or if so, the inheritance of the
Font-formatting?

Brgds Sige


Norman Jones wrote:
Hi Sige,

Looking again at your example data, change:

.Resize(1, 2) = .End(xlToRight).Value

to:

.Value = .End(xlToRight).Value

---
Regards,
Norman

Find first non-empty cell ranght from column A
 

Hi Sige,

No enhancements needed ... or if so, the inheritance of the
Font-formatting?

Try:
'=============
Public Sub Tester2()
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range

On Error Resume Next
Set rng = Intersect(ActiveSheet.UsedRange, Columns("A"))
Set rng2 = rng.SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng2 Is Nothing Then
For Each rCell In rng2.Cells
With rCell
.End(xlToRight).Copy Destination:=.Item(1)
End With
Next rCell
End If

End Sub
'<<=============


---
Regards,
Norman



"Sige" wrote in message
oups.com...
Hi Norman,

Thanks again.
It does exactly what it should!
No enhancements needed ... or if so, the inheritance of the
Font-formatting?

Brgds Sige


Norman Jones wrote:
Hi Sige,

Looking again at your example data, change:

.Resize(1, 2) = .End(xlToRight).Value

to:

.Value = .End(xlToRight).Value

---
Regards,
Norman

Find first non-empty cell ranght from column A
 

Hi Norman,

It is not only the Font formatting it inherits... but it is more than
fine!

Thank you very much,
Un buono fine settimana!
Ciao Sige

PS: Tu hai ricevuto il titolo di mvp questo anno?

Find first non-empty cell ranght from column A
 

Hi Sige,

It is not only the Font formatting it inherits... but it is more than
fine!


Try:
'=============
Public Sub Teste3()
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range

On Error Resume Next
Set rng = Intersect(ActiveSheet.UsedRange, Columns("A"))
Set rng2 = rng.SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng2 Is Nothing Then
For Each rCell In rng2.Cells
With rCell
.Value = .End(xlToRight).Value
.Font.Name = .End(xlToRight).Font.Name
.Font.FontStyle = .End(xlToRight).Font.FontStyle
.Font.Size = .End(xlToRight).Font.Size
.Font.Underline = .End(xlToRight).Font.Underline
.Font.ColorIndex = .End(xlToRight).Font.ColorIndex
End With
Next rCell
End If

End Sub
'<<=============

---
Regards,
Norman

Find first non-empty cell ranght from column A
 

Hi Norman,

Thanks, thanks, thanks!
Brgds Sige


Norman Jones wrote:
Hi Sige,

It is not only the Font formatting it inherits... but it is more than
fine!


Try:
'=============
Public Sub Teste3()
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range

On Error Resume Next
Set rng = Intersect(ActiveSheet.UsedRange, Columns("A"))
Set rng2 = rng.SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng2 Is Nothing Then
For Each rCell In rng2.Cells
With rCell
.Value = .End(xlToRight).Value
.Font.Name = .End(xlToRight).Font.Name
.Font.FontStyle = .End(xlToRight).Font.FontStyle
.Font.Size = .End(xlToRight).Font.Size
.Font.Underline = .End(xlToRight).Font.Underline
.Font.ColorIndex = .End(xlToRight).Font.ColorIndex
End With
Next rCell
End If

End Sub
'<<=============

---
Regards,
Norman

Find first non-empty cell ranght from column A
 

Hi Norman,

I am trying to let you sub work for all the ws in my wbk.
I ended up with this sub:

To me it seems logic ... and it works!
Though it does not pick up the formatting in my practical example?!
(In an example new virgin workbook it does, but not in the wbk on which
I would like to apply it...?)

Bizar behaviour ... You have -again- any idea?

Best Regards, Sige

'=============
Public Sub Tester3()
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Set rng = Intersect(ws.UsedRange, ws.Columns("A"))
Set rng2 = rng.SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng2 Is Nothing Then
For Each rCell In rng2.Cells
With rCell
.Value = .End(xlToRight).Value

.Font.Name = .End(xlToRight).Font.Name
.Font.FontStyle = .End(xlToRight).Font.FontStyle
.Font.Bold = .End(xlToRight).Font.Bold
.Font.Size = .End(xlToRight).Font.Size
.Font.Underline = .End(xlToRight).Font.Underline
.Font.ColorIndex = .End(xlToRight).Font.ColorIndex

End With
Next rCell
End If
Next ws
End Sub

Find first non-empty cell ranght from column A
 

Hi Sige,

I am trying to let you sub work for all the ws in my wbk.
I ended up with this sub:

To me it seems logic ... and it works!
Though it does not pick up the formatting in my practical example?!
(In an example new virgin workbook it does, but not in the wbk on which
I would like to apply it...?)

Bizar behaviour ... You have -again- any idea?

Send me a copy of a problematic workbook. Replace any private data.


---
Regards,
Norman