APPLY A CELL's FORMAT WITHOUT SELECTING

[Faraz A. Qureshi]

Any idea how to have a cell(s) for example A1:A10 acquire the exact format as
of B1 without copy, selecting & pasting special xlPasteFormats?

 

[Rick Rothstein]

This macro will do that...

Sub CopyB1sFormat()
Dim V As Variant, Ra As Range, Rb As Range
Set Ra = Range("A1:A10")
Set Rb = Range("B1")
V = Join(WorksheetFunction.Transpose(Ra.Value), Chr$(1))
Rb.Copy Ra
Ra = WorksheetFunction.Transpose(Split(V, Chr$(1)))
End Sub

 

[Faraz A. Qureshi]

WOW!
XClent!
Thanx a lot a pal!
Really did off-load a burden!

However would u kindly interpret the code?

 

[Rick Rothstein]

Here is the same code I posted along with comments explaining what is going
on. The main thrust of the code is to protect the original values in the
cells having their format changed (because the Copy operation will overwrite
them).

Sub CopyB1sFormat()
' Declare variable
Dim V As Variant, Ra As Range, Rb As Range
' Assign the destination range
Set Ra = Range("A1:A10")
' Assign the source cell to use for the formatting
Set Rb = Range("B1")
' Copy existing values from the destination cells into a string...
' Transpose takes a contiguous **column** of cells and creates a
' one-dimensional array from them which the Join function can then
' operate on... the Chr$(1) is just a delimiter character... any
' character can be use, but that character should never be able to
' appear in the text of any cell being joined (otherwise Split'ting
' them apart later will be impossible to do... Chr$(1) is a just
' a non-typable character that can't (under normal circumstances)
' appear in text string.
V = Join(WorksheetFunction.Transpose(Ra.Value), Chr$(1))
' Copy the contents and formatting from the source cell into the
' destination cell
Rb.Copy Ra
' Put the original values that were in the source cells back into
' the source cells. Split creates a one-dimensional array from the
' text string stored in V and the Transpose function puts it back
' into a form that can be assign to a range of cells.
Ra = WorksheetFunction.Transpose(Split(V, Chr$(1)))
End Sub