Fill To Right

PHOTO EMBED

Wed Sep 08 2021 06:03:04 GMT+0000 (UTC)

Saved by @Darkleech #vba

Sub FillToRight() '(Ctrl+Shift+R)
'declare variables
TotalCols = ActiveCell.CurrentRegion.Columns.Count
CurrentCol = ActiveCell.Column
ColsToFill = TotalCols - CurrentCol
'declare starting cell and ending cell
cellSource = ActiveCell.Address
cellTarget = Cells(ActiveCell.Row, ActiveCell.Column + ColsToFill).Address
'check that activecell is not blank
If ActiveCell.Value = "" Then
GoTo skip_fill_1
End If
'check for completed cells in other columns of active row
CompletedCells = Application.WorksheetFunction.CountA(Range(cellSource, cellTarget))
If CompletedCells <> 1 Then
GoTo skip_fill_2
End If
'fill to right
On Error GoTo skip_fill_3
Selection.AutoFill Destination:=Range("" & cellSource & ":" & cellTarget & ""), Type:=xlFillDefault
Range("" & cellSource & ":" & cellTarget & "").Select
Exit Sub
'error traps
skip_fill_1:
MsgBox "Unable to fill right - active cell is blank", vbCritical, "ERROR"
Exit Sub
skip_fill_2:
MsgBox "Unable to fill right - other data exists on this row", vbCritical, "ERROR"
Exit Sub
skip_fill_3:
MsgBox "Unable to fill right - unspecified error", vbCritical, "ERROR"
Exit Sub
End Sub
content_copyCOPY