Is this possible? VBA to do the following:

[squidmark]

1. Find the 3rd to last column with data in it, and select the cells in that column from row 3 to row 200
2. Copy those cells (some date, some formulas) over to the next column on the right.

So. . . if the last column with data in it was column J, then have the macro select cells H2:H200 and copy to I2:I200.

but the next time the macro is run, the last column with data may be column R, and I'd need to copy P2:P200 to Q2:Q200.

Thanks in advance for your help, if this is even possible.

 

[Trebor76]

Hi there,

Try this:

Sub Macro1()

    Dim lngColLast As Long
    Dim strColCopy As String, _
        strColPaste As String
    
    If WorksheetFunction.CountA(Sheets(ActiveSheet.Name).Cells) > 0 Then
        lngColLast = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        If lngColLast >= 3 Then
            strColCopy = ColLetter(lngColLast - 2)
            strColPaste = ColLetter(lngColLast - 1)
            With ActiveSheet
                Sheets(.Name).Range(strColCopy & "2:" & strColCopy & "200").Copy _
                    Destination:=Sheets(.Name).Range(strColPaste & "2:" & strColPaste & "200")
            End With
        End If
    Else
        MsgBox "There is no data in " & ActiveSheet.Name & " to find the last column!!", vbExclamation, "Last Column Editor"
        Exit Sub
    End If

End Sub
Function ColLetter(lngColNum As Long) As String

    ColLetter = Cells(1, lngColNum).Address(False, False)
    ColLetter = Left(ColLetter, Len(ColLetter) - 1)

End Function

Regards,

Robert

 

[squidmark]

I should add it would be very helpful if the copy was really an autofill. Something like:

Range("P2:P200").Select
Selection.Autofill Destination:=Range("P3:Q200"), Type:=xlFillDefault

I need this so the month automatically moves to the next month, rather than just copying the current month to the new column.

My only issue is that the ranges won't always be P2:P200 and P3:Q200. I need them to be those rows, but column for the first range be the 3rd column from the end.

 

[squidmark]

Hi there,

Try this:

Sub Macro1()

    Dim lngColLast As Long
    Dim strColCopy As String, _
        strColPaste As String
    
    If WorksheetFunction.CountA(Sheets(ActiveSheet.Name).Cells) > 0 Then
        lngColLast = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        If lngColLast >= 3 Then
            strColCopy = ColLetter(lngColLast - 2)
            strColPaste = ColLetter(lngColLast - 1)
            With ActiveSheet
                Sheets(.Name).Range(strColCopy & "2:" & strColCopy & "200").Copy _
                    Destination:=Sheets(.Name).Range(strColPaste & "2:" & strColPaste & "200")
            End With
        End If
    Else
        MsgBox "There is no data in " & ActiveSheet.Name & " to find the last column!!", vbExclamation, "Last Column Editor"
        Exit Sub
    End If

End Sub
Function ColLetter(lngColNum As Long) As String

    ColLetter = Cells(1, lngColNum).Address(False, False)
    ColLetter = Left(ColLetter, Len(ColLetter) - 1)

End Function

Regards,

Robert

Oh, you must have posted just as I was typing up my clarification. thanks. I'll give it a try.

 

[Trebor76]

but column for the first range be the 3rd column from the end

The macro does that

 

[squidmark]

Thank You! That worked great, with one exception. It did not advance the month by one month. It just copied the month in the previous column into this blank column. So if the new column is Col P, and cell O4 says Aug-11, I need P4 to say Sep-11. But this copies the Aug-11.

Other than that, it works great!

Hi there,

Try this:

Sub Macro1()

    Dim lngColLast As Long
    Dim strColCopy As String, _
        strColPaste As String
    
    If WorksheetFunction.CountA(Sheets(ActiveSheet.Name).Cells) > 0 Then
        lngColLast = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        If lngColLast >= 3 Then
            strColCopy = ColLetter(lngColLast - 2)
            strColPaste = ColLetter(lngColLast - 1)
            With ActiveSheet
                Sheets(.Name).Range(strColCopy & "2:" & strColCopy & "200").Copy _
                    Destination:=Sheets(.Name).Range(strColPaste & "2:" & strColPaste & "200")
            End With
        End If
    Else
        MsgBox "There is no data in " & ActiveSheet.Name & " to find the last column!!", vbExclamation, "Last Column Editor"
        Exit Sub
    End If

End Sub
Function ColLetter(lngColNum As Long) As String

    ColLetter = Cells(1, lngColNum).Address(False, False)
    ColLetter = Left(ColLetter, Len(ColLetter) - 1)

End Function

Regards,

Robert