PDA

View Full Version : [SOLVED] Finding Last Column with CF Format - Paste Previous 6 columns format to Empty Column



kewiopex
11-15-2016, 07:59 AM
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
11-16-2016, 01:20 PM
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
11-16-2016, 01:39 PM
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
11-16-2016, 02:29 PM
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
11-16-2016, 03:26 PM
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
11-16-2016, 05:15 PM
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
11-17-2016, 06:04 AM
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
11-17-2016, 12:21 PM
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
11-17-2016, 06:56 PM
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
11-17-2016, 07:14 PM
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
11-18-2016, 05:36 AM
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
11-18-2016, 06:39 AM
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
11-18-2016, 09:21 AM
Great stuff! I will amend the code and give it a try!

Leith Ross
11-18-2016, 09:48 AM
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
11-18-2016, 01:40 PM
Leith
A big thank you!Works like a charm!!

Leith Ross
11-18-2016, 02:21 PM
Hello kewiopex,

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

joky
07-19-2017, 08:54 AM
Hello kewiopex,

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

Mr. Leith Ross you are a humble man