VBA Find Last Populated Cell In An Area Then Perform Tasks

[TkdKidSnake]

Good morning all,

I am after some help with VBA to perform the follow tasks

1. Find the last populated cell within range C4 to C174
2. Copy the last populated row from A to H
3. Paste values @ A174 to H174
4. Delete the original range copied
5. Delete all rows based on C being blank in range C4 to C174

Any help you can provide would be greatly appreciated

Thanks in advance

 

[footoo]

Dim cel As Range
If [C174] <> "" Then
    Set cel = [C174]
Else: Set cel = [C174].End(xlUp)
End If
With cel(1, -1).Resize(, 8)
    .Copy [A174]
    .ClearContents
End With
On Error Resume Next
[C4:C174].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

 

[gallen]

I've been beaten to it but i've written it so I'll post it!

Sub CopyPasteDelete()
    Dim lr As Long ' last used row
    
    lr = Cells(174, "C").End(xlUp).Row
    
    Range("A" & lr & ":H" & lr).Copy Range("A174")
    Rows(lr).Delete
    
    For i = 174 To 4 Step -1
        If Cells(i, "C") = "" Then Rows(i).Delete
    Next i
    
End Sub

 

[TkdKidSnake]

Works a treat thanks, the only issue I have is I am losing the formatting hence the reason I wanted to paste the copied values in cells A174 to H174 the remove all rows with blanks.

 

[gallen]

Change how it is pasted:

Sub CopyPasteDelete()
    Dim lr As Long ' last used row
    
    lr = Cells(174, "C").End(xlUp).Row
    
    Range("A" & lr & ":H" & lr).Copy
[COLOR=#ff0000]    Range("A174").PasteSpecial xlPasteAll[/COLOR]
    Rows(lr).Delete
    
    For i = 174 To 4 Step -1
        If Cells(i, "C") = "" Then Rows(i).Delete
    Next i
    
End Sub

 

[TkdKidSnake]

I have changed it now and it works a treat thank you

Change how it is pasted:

Sub CopyPasteDelete()
    Dim lr As Long ' last used row
    
    lr = Cells(174, "C").End(xlUp).Row
    
    Range("A" & lr & ":H" & lr).Copy
[COLOR=#ff0000]    Range("A174").PasteSpecial xlPasteAll[/COLOR]
    Rows(lr).Delete
    
    For i = 174 To 4 Step

 

[TkdKidSnake]

This works great and is quite quick, the only issue I have is the reason for copying and the pasting values was so that I do not lose the formatting set-up

Can you help with this.

Dim cel As Range
If [C174] <> "" Then
    Set cel = [C174]
Else: Set cel = [C174].End(xlUp)
End If
With cel(1,

 

[gallen]

For footoo's version, it's the same thing. Instead of copying and pasting in the same line of code, do it separate:

Dim cel As RangeIf [C174] <> "" Then
    Set cel = [C174]
Else: Set cel = [C174].End(xlUp)
End If
With cel(1, -1).Resize(, 8)
    .Copy
    [A174][COLOR=#FF0000].PasteSpecial xlPasteAll[/COLOR]
    .ClearContents
End With
On Error Resume Next
[C4:C174].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0