Finding Last Column with CF Format - Paste Previous 6 columns format to Empty Column

[kewiopex]

Dear Experts
I am a newbie who is trying to help out others who have limited excel exposure, including manual activity. I have been researching how to find the last column with Condition Format (CF) format but no data and then pasting the 6 columns including the last column into the vacant column beside the last column with CF.
I have seen the usedrange and heard arguments on its issues and have also seen coding for finding columns with data such as on Ron De Bruins website http://www.rondebruin.nl/win/s9/win005.htm. None of them does what I need to do.
I have attached a file with the current configuration that has the CF in column BB and no data in previous 5 columns. What I need help with is to find the last column with the CF format and copy and paste as described above. NOTE: the header rows may not be present when determining the last column.
Any of your excellent help would be greatly appreciated.

[kewiopex]

Dear Experts
I did some work on the macro to find the last column with condition formatting (no data) and then paste the formatting to the empty range after the last column and got it to work.

However, I am not sure it is the best or efficient coding and would like to see if there is a better code to learn from. Any help would be greatly appreciated.

There is an issue that has been stated elsewhere from others in that the cell formatting will not reset unless the columns are deleted and the file saved using the LastColumn LastColumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column code.
Here is the code that I used and the xlsm file is attached that will work.

Sub Test()
    Dim ThisWorkbook As Workbook
    Dim source As Worksheet
    Dim destination As Worksheet
    Dim emptyColumn As Long
    Dim LastColumn As Long
    Set source = ActiveSheet
    Set destination = ActiveSheet
With ActiveSheet
        LastColumn = .Range("A4").SpecialCells(xlCellTypeLastCell).Column
    End With
emptyColumn = LastColumn
If emptyColumn > 1 Then
        emptyColumn = emptyColumn + 1
    End If
source.Range("AX4:BB5").Copy destination.Cells(4, emptyColumn)
End Sub

[kewiopex]

Sorry, as well as requesting help on the most efficient coding for the macro that I have written above, I would also like to also request assistance on how to just paste the format (condition formatting) on the copy range that may contain data if I change the coding to look at range that has data ( data not needed). I tried to add the past special code and it did not work for me.
All the best and thank you in advance.

[Leith Ross]

Hello kewiopex,

This worked for me on your data. Try it and let me know if it needs any changes.

Sub TestA()
Dim Cell As Range
Dim DstWks As Worksheet
Dim LastCell  As Range
Dim LastColumn  As Long
Dim LastRow  As Long
Dim Rng  As Range
Set DstWks = ActiveSheet
' Start at Row 4
Set Rng = ActiveSheet.UsedRange
Set Rng = Intersect(Rng, Rng.Offset(3, 0))
' Save the last cell with Conditional Formatting.
For Each Cell In Rng
If Cell.FormatConditions.Count > 0 Then Set LastCell = Cell
Next Cell
' If there is a Last Cell with Condtional Formatting copy and paste the range to the destination.
If Not LastCell Is Nothing Then Rng.Copy DstWks.Cells(4, LastCell.Column + 1)
End Sub

[kewiopex]

Leith
Your response is much appreciated. I tried it out and it did work but proceeded to copy and paste the entire 2 rows. So I amended the code to just copy the last 6 columns and to also just paste the (condition) formatting. However when I attached the .pastespecial xLFotmats to the last cell If Not LastCell Is Nothing Then Rng.Copy DstWks.Cells(4, LastCell.Column + 1).pastespecial xLFormats it failed to do so and I get a compile error End of statement. Any suggestions?

Sub TestA()
    Dim Cell        As Range
    Dim DstWks      As Worksheet
    Dim LastCell    As Range
    Dim LastColumn  As Long
    Dim LastRow     As Long
    Dim Rng         As Range
     
    Set DstWks = ActiveSheet
     
     ' Start at Row 4
    Set Rng = ActiveSheet.UsedRange
    Set Rng = Intersect(Rng, Rng.Offset(3, 0))
     
     ' Save the last cell with Conditional Formatting.
    For Each Cell In Rng
        If Cell.FormatConditions.Count > 0 Then Set LastCell = Cell
    Next Cell
     
     ' If there is a Last Cell with Condtional Formatting copy and paste the range to the destination.
    If Not LastCell Is Nothing Then Range("AR4:AW5").Copy DstWks.Cells(4, LastCell.Column + 1).pastespecail xLFormats
     
End Sub

[Leith Ross]

Hello kewiopex,

Sorry for the late response. I have been trying to get an appointment today for my new kitten.

I am not sure why your wanting to use Paste Special. Conditional Formats will only be pasted using the Range.Copy or Worksheet.Paste. Can you explain in more detail what you want to do?

[kewiopex]

Hi Leith
With regards to using the paste format, I am trying to simplify the process so that persons with very limited exposure can just hit a button to do the work. So in this case, I just want to extend out the cells keeping the format in a block fashion. The other persons would then only need to enter the data and not need to be concerned with keeping the format, or in this case condition format pattern. Hopefully this provides a rationale basis. If not let me know.
Good luck on the kitchen. The wife is after me to do something with ours but larger. This means wall knockdowns.
Any insights are welcome to do the past with formats.

[Leith Ross]

Hello kewiopex,

The formats can be transferred with the Paste operation and then the cell values could be cleared. That would keep the block format. What do you think?

[kewiopex]

Hey Leith
That works for me. Simple and elegant and I think that event first beginners can do that. I will add instructions with a macro button to that effect.
Thanks a million!

[Leith Ross]

Hello kewiopex,

Try this version of the macro and let me know how this works for you.

Sub TestB() 
     
    Dim Cell        As Range 
    Dim DstWks      As Worksheet 
    Dim LastCell    As Range 
    Dim LastColumn  As Long 
    Dim LastRow     As Long 
    Dim Rng         As Range 
     
    Set DstWks = ActiveSheet 
     
     ' Start at Row 4
    Set Rng = ActiveSheet.UsedRange 
    Set Rng = Intersect(Rng, Rng.Offset(3, 0)) 
     
     ' Save the last cell with Conditional Formatting.
    For Each Cell In Rng 
        If Cell.FormatConditions.Count > 0 Then Set LastCell = Cell 
    Next Cell 
     
     ' If there is a Last Cell with Condtional Formatting 
     ' Copy and Paste the range to the destination with no values.
    If Not LastCell Is Nothing Then 
        Rng.Copy DstWks.Cells(4, LastCell.Column + 1) 
        DstWks.Cells(4, LastCell.Column + 1).ClearContents
    End If


End Sub

[kewiopex]

Good morning Leith
Thank you for the comeback, but it did not clear the values. Not sure why it did not clear, but the good thing is that the code ran without any issues.

[p45cal]

Good morning Leith
Thank you for the comeback, but it did not clear the values. Not sure why it did not clear, but the good thing is that the code ran without any issues.

Here (Excel 2010) you CAN paste conditional formats with .pastespecial and xlFormats, so you may not need to .clearcontents

Also there's a gotcha to be aware of with the current routine for finding the last column with CFs in; since excel runs through the range of cells row1, columns 1 to n, row2, columns 1 to n etc., if there are conditional formats lower in the range which don't extend as far to the right as rows above, your lastcell.column could be awry.
You could use:

Set CFRng = Cells.SpecialCells(xlCellTypeAllFormatConditions)
For Each cll In CFRng.Cells
  If cll.Column > CFmaxColm Then CFmaxColm = cll.Column
Next cll
MsgBox CFmaxColm

or if there are very many cells with conditional formatting in, the following might be quicker/less resource-hungry:

Set CFRng = Cells.SpecialCells(xlCellTypeAllFormatConditions)
For Each are In CFRng.Areas
  If are.Column + are.Columns.Count - 1 > CFmaxColm Then CFmaxColm = are.Column + are.Columns.Count - 1
Next are
MsgBox CFmaxColm

[kewiopex]

Great stuff! I will amend the code and give it a try!

[Leith Ross]

Hello kewiopex,

My apologies to you. You were correct about PasteSpecial. The Range.Copy does not function correctly. Here is the working code.

Sub TestC()


    Dim Cell        As Range
    Dim DstWks      As Worksheet
    Dim LastCell    As Range
    Dim LastColumn  As Long
    Dim LastRow     As Long
    Dim Rng         As Range
    
        Set DstWks = ActiveSheet
        
        ' Start at Row 4
        Set Rng = ActiveSheet.UsedRange
        Set Rng = Intersect(Rng, Rng.Offset(3, 0))
    
        ' Save the last cell with Conditional Formattting.
        For Each Cell In Rng
            If Cell.FormatConditions.Count > 0 Then Set LastCell = Cell
        Next Cell
        
        ' If there is a Last Cell with Condtional Formatting copy and paste the formatting to the destination.
        If Not LastCell Is Nothing Then
            Rng.Copy
            DstWks.Cells(4, LastCell.Column + 1).Resize(Rng.Rows.Count, Rng.Columns.Count).PasteSpecial xlPasteFormats
        End If
                   
End Sub

[kewiopex]

Leith
A big thank you!Works like a charm!!

[Leith Ross]

Hello kewiopex,

You're welcome. I learned something new from helping you with this, thanks.

[joky]

Hello kewiopex,

You're welcome. I learned something new from helping you with this, thanks.

Mr. Leith Ross you are a humble man