VBA - Excel Append Every Active Row With File Name

Question

I am new to VBA so bear with me. I would like to append in the last cell of each active row the filename. So for example Row/Column A1, B1, C1, and D1 are populated I would like to add the filename to cell E1. The filename should only be appended to active rows. I have played around with different iterations without much luck. Below is what I have so far and the logic is clearly incorrect. Any help would be appreciated. Thanks!

Sub InsertFilename()

Dim Count1 As Long
Count1 = 1
Dim ColumnE As String
ColumnE = "E1"


While Cells(Count1, 1) <> ""
Range(ColumnE).Select
ActiveCell.FormulaR1C1 = _
    "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1)"
ColumnE = Range(ActiveCell, ActiveCell.Offset(1, 0)).Select
Count1 = Count1 + 1
Wend

End Sub

score 0 · Accepted Answer · answered Jan 26 '15 at 21:05

This code iterates from the first row to the last, and it finds the last column in each row by imitating the CTRL+LEFT from the edge of the sheet.

It does not assume that all the rows have the same number of columns

Dim LastRow As Long
Dim LastColumn As Long
Sub InsertFileName()
  Application.ScreenUpdating = False
  Dim i as Long
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  For i=1 To LastRow
    LastColumn = ActiveSheet.Cells(i, ActiveSheet.Columns.Count).End(xlToLeft).Column
    ActiveSheet.Cells(i,LastColumn+1)="=CELL(""filename"")"
  Next i
  Application.ScreenUpdating = True
End Sub

Works perfectly! Thanks for taking the time and the explanation. — mrscottwalker, Jan 26 '15 at 21:42

score 0 · Answer 2 · answered Jan 26 '15 at 21:05

A simple solution. Add your values for fileName to be appended and the start row stRow of your data.

Sub InsertFilename()
Dim stRow As Long, endRow As Long, endCol As Long, c As Long
Dim fileName As String

fileName = "C:\Data\somefile.xlsx"
stRow = 1
    With ActiveSheet
        endRow = .Cells(Rows.Count, 1).End(xlUp).Row
            For c = stRow To endRow
                endCol = .Cells(c, Columns.Count).End(xlToLeft).Column
                    If endCol > 1 Then
                        .Cells(c, endCol + 1) = fileName
                    End If
            Next
    End With
End Sub

score 0 · Answer 3 · answered Jan 26 '15 at 21:06

This solution tests for activity using Counta and uses each active row's last column to use the activeworkbook's fullname.

Dim lngLastRow As Long
Dim lngLastCol As Long
Dim lngCounter As Long

lngLastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngLastCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

For lngCounter = 1 To lngLastRow
    If WorksheetFunction.CountA(Range(Cells(lngCounter, 1), Cells(lngCounter, lngLastCol))) > 0 Then
        Cells(lngCounter, lngLastCol + 1).End(xlToLeft).Offset(0, 1).Value = ActiveWorkbook.FullName
    End If
Next lngCounter

VBA - Excel Append Every Active Row With File Name

3 Answers3

Linked