I want to embed an OLEObject (text file) in Excel, with the filename being derived from a particular cell. I can do this as a one off action but am now trying to make it work in a loop through all the cells in a column, finishing when it comes across an empty cell.
I can’t seem to get the right syntax to make the If/Else loop work:
Sub Insert_Text_File() Dim ol As OLEObject Dim path As String Dim file As String Dim filenameinvisible As String Dim rangeA As Range Dim rangeD As Range path = ActiveWorkbook.Path file = Range(i,1).Value & "-Live" & ".txt" Set rangeA = Range("A" & i) Set rangeD = Range("D" & i) For i = 2 To 200 If Range("A" & i) <> "" Then Set ol = Worksheets("Inventory").OLEObjects.Add (Filename:= path & "\" & file, Link:=False, DisplayAsIcon:=True, Height:=10) ol.Top =Range("D" & i).top ol.left=Range("D" & i).left End If Next i End Sub
I think the problem with your current approach is that your are assigning the value to the
path variable only once –
file = Range(i,1).Value & "-Live" & ".txt" before the loop increases
A better approach requiring less variables would be using a
for each loop using a
cell variable of
Range type and relying on VBA to find the last row used rather than hard-coding 200 into the loop.
Try this approach and let us know if that has worked.
Sub Insert_Text_File() Application.ScreenUpdating = False Dim cell As Range ' loop each cell in column A For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row) ' make sure the cell is NOT empty before doing any work If Not IsEmpty(cell) Then ' create and insert a new OleObject based on the path Dim ol As OLEObject ' ActiveWorkbook.path & "\" & cell & "-Live.txt" will make the filename Set ol = ActiveSheet.OLEObjects.Add( _ Filename:=ActiveWorkbook.path & "\" & cell & "-Live.txt", _ Link:=False, _ DisplayAsIcon:=True, _ Height:=10) ' align the OleObject with Column D - (0 rows, 3 columns to the right from column A) With ol .Top = cell.Offset(0, 3).Top .Left = cell.Offset(0, 3).Left End With End If Next Application.ScreenUpdating = True End Sub