How do I adapt this to work with another worksheet rather than the worksheet I have visible.
If (IsEmpty(Cells(RowNum, ColumnNum).Value)) Then
GoTo nextloop:
End If
I have moved parenthesis, tried including workbook name but I think I'm just not getting the syntax. I'm not very good with excel.
What I'm trying to achieve. Take all contents of a column, push the data into a bat file. Script will be launched from a button on another worksheet.
UPDATED Full Code: (Tried Ryan's answer, was getting error. Fixed it but then the script did nothing.)
Sub Send2Bat()
Dim ColumnNum: ColumnNum = 26 ' Column Z - I have the I J and K Columns concatenated there.
Dim RowNum: RowNum = 0
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\Test\Convert.bat") 'Output Path
aFile = "C:\Test\Convert.bat"
Dim OutputString: OutputString = ""
Dim LastRow: LastRow = Application.ActiveSheet.Cells(Application.ActiveSheet.Rows.Count, ColumnNum).End(xlUp).Row
Do
nextloop:
RowNum = RowNum + 1
If (IsEmpty(Cells(RowNum, ColumnNum).Value)) Then
GoTo nextloop:
End If
OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine
Loop Until RowNum = LastRow
objFile.Write (OutputString)
Set objFile = Nothing
Set objFSO = Nothing
End Sub
I made an excel workbook and put some data in column z for Sheet 1 and Sheet 2.
And I tweaked your code to read as follows:
Sub Send2Bat()
Dim ColumnNum: ColumnNum = 26 ' Column Z - I have the I J and K Columns concatenated there.
Dim RowNum: RowNum = 0
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\Test\Convert.bat") 'Output Path
aFile = "C:\Test\Convert.bat"
Dim OutputString: OutputString = ""
Dim targetSheet As Worksheet
Set targetSheet = Application.Worksheets("Sheet1")
Dim LastRow: LastRow = targetSheet.Cells(targetSheet.Rows.Count, ColumnNum).End(xlUp).Row
Do
RowNum = RowNum + 1
If Not (IsEmpty(targetSheet.Cells(RowNum, ColumnNum).Value)) Then
OutputString = OutputString & Replace(targetSheet.Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine
End If
Loop Until RowNum = LastRow
objFile.Write (OutputString)
Set objFile = Nothing
Set objFSO = Nothing
End Sub
And it produced the following file:
So then I updated the targetSheet name to "Sheet2"
Set targetSheet = Application.Worksheets("Sheet2")
and executed again. The file updated to this:
So, the code is good at least in its basic form. Do you have anything else updating the sheets or moving things around while this is happening?
Related
I am running the following code. The code is for finding some particular values in all the Excel sheets in a folder.
It gives me the error
"Sorry, we couldn't find the file. Is it possible it was moved, renamed or deleted?"
when it executes
Set wbSlave = Workbooks.Open(filename:=myfilname)
Please help.
Sub find_cells()
Dim i, j As Integer
Dim cell_content As String
Dim total_values As Long
Dim cell_location As Range
Dim cell_address As String
Dim sht As Worksheet
Dim myfilname As String
Dim fldrpath As String
Dim wbMaster As Workbook
Dim wbSlave As Workbook
Dim currentfilename As String
Set wbMaster = ThisWorkbook
j = 3
total_values = Application.WorksheetFunction.CountA(wbMaster.Sheets("Engine").Range("A:A"))
fldrpath = "C:\test\"
myfilname = Dir(fldrpath & "*.xls*")
Application.ScreenUpdating = False
Do While myfilname <> ""
'myfilname = Dir()
Set wbSlave = Workbooks.Open(filename:=myfilname)
For Each sht In wbSlave.Sheets
For i = 2 To total_values
cell_content = wbMaster.Sheets("Engine").Range("A" & i).Value
With sht.UsedRange
Set cell_location = .Find(cell_content, LookIn:=xlValues, MatchCase:=False, SearchFormat:=False)
If Not cell_location Is Nothing Then
cell_address = cell_location.Address
Do
wbMaster.Sheets("Sheet1").Columns(j).Value = cell_location.EntireColumn.Value
j = j + 1
Set cell_location = .FindNext(cell_location)
Loop While Not cell_location Is Nothing And cell_location.Address <> cell_address
End If
End With
Set cell_location = Nothing
If i = total_values Then Exit For
Next i
Next
myfilname = Dir()
Loop
End Sub
The Dir function returns only the matching filename - no path. Then if you try to open it and you are currently not in a correct folder, you get this error.
Set a watch to the variable myfilname or just add Debug.Print myfilname and you see it right away.
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/dir-function
I created a macro to rename files, but received this error:
Run-time error 53 File not found
But if I keep my cursor, it picks my location path correctly
"Name folder & Curname As folder & Newname"
Sub getname()
Dim folder As String
mfolder = Sheets("Sheet1").Cells(1, 2).Value
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
i = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(mfolder)
For Each objFile In objFolder.Files
Sheets("Sheet1").Cells(i, 1).Value = objFile.Name
i = i + 1
Next objFile
End Sub
Sub reName()
Dim mfolder As String
Dim CurName As String
Dim NewName As String
Dim i As Integer
i = 3
mfolder = Sheets("Sheet1").Cells(1, 2).Value
Do While Sheets("Sheet1").Cells(i, 1).Text <> "" And Sheets("Sheet1").Cells(i, 2).Text <> ""
CurName = Sheets("Sheet1").Cells(i, 1).Text
NewName = Sheets("Sheet1").Cells(i, 2).Text
Name mfolder & CurName As mfolder & NewName
i = i + 1
Loop
MsgBox ("Complete")
End Sub
As a rule of thumb I would always use early binding of Microsoft scripting runtime. This gives you access to intellisense and other benefits when using external references.
Tools >> references
Once added you import the object reference as follows.
dim fso as filesystemobject
set fso = new filesystemobject
this allows you to do things like this.
dim fldr as fldr
set fldr = fso.getfolder("c:\test_folder")
and iterating through files
dim fl as file
for each fl in fldr.files
do something
next fl
It always helps me personally to see what options are available when using a new reference in VBA .
(when using late binding like you are you don't have this luxury)
and mainly renaming files
fldr.move("C:\test_folder2")
In my opinion you should store the path of the file
objFile.path not objFile.Name
this would store something like C:\test\test.text
so fix with getting the list of files
Function list_files():
' log all files
Dim fso As filesystemobject
Set fso = New filesystemobject
Dim fldr As fldr
Set fldr = fso.getfolder("c:\test_folder")
Dim fl as file
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
Dim i As Integer
i = 2
For Each fl In fldr.Files
ws.Cells(i, 1) = fl.Path
Next fl
End Function
and renaming
Function rename_files():
' log all files
Dim fso As filesystemobject
Set fso = New filesystemobject
Dim fl As file
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
Dim lr As Integer
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lr
If ws.Cells(x, 2) <> "" Then
Set fl = fso.getfile(ws.Cells(x, 1))
fl.Move (ws.Cells(x, 2))
End If
Next x
End Function
Something else to note is that when iterating through cells its always best practice to use something along the lines of this.
dim ws as worksheet
set ws = worksheets("Sheet1") ' get the worksheet
dim lr as integer ' create lr interger reference
lr = ws.cells(rows.count,1).end(xlup).row
for x = 2 to lr
'do something
next x
lets break down whats happening here.
ws.cells(rows.count,1).end(xlup).row
ws in the worksheet
cells in the cells
rows.count get the last row
1 in column one
so....
ws.cells(rows.count,1) is referencing ALL cells in column 1
then....
.end(xlup) goes upwards to where the data starts (or the blank lines end)
row logs the row number
Then when you do your for loop you are not checking for the empty cells as you already know where it is.
for x = 2 to lr 'the last row in the data with data in it.
if ws.cells(x,2) <> "" then
'do something because column 1 and 2 both have no value in the cell
end if
next x
hope this helps somewhat
I have some csv files in one folder. They all contain 3 specific columns. The number of total columns and the order may vary.
I want to concatenate all 3 columns with an underscore and write them in a single column in the worksheet that is running the code.
Here is what I have so far:
Option Explicit
Sub test()
Dim i As Long
Dim LastRow As Long
Dim Columns()
Columns = Array("Column1", "Column2", "Column3")
'Find Columns by Name
For i = 0 To 2
Columns(i) = Rows(1).Find(What:=Columns(i), LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False).Column
Next i
'Debug.Print Columns(0)
'Debug.Print Columns(1)
'Debug.Print Columns(2)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
Cells(i, 1) = Cells(i, Columns(0)) & "_" & Cells(i, Columns(1)) & "_" & Cells(i, Columns(2))
Next i
End Sub
As you can see, this does what I want, but only for the active sheet.
I actually want to loop through all csv files in the same folder as the active sheet and write the results in the first sheet, first column of the sheet running the code (which is not a csv itself obviously).
How can I do this?
thanks!
This is a code that will loop through a folder
Sub Button1_Click()
Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Set Wb = ThisWorkbook
'change the address to suite
MyDir = "C:\WorkBookLoop\"
MyFile = Dir(MyDir & "*.xls") 'change file extension
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Do While MyFile <> ""
Workbooks.Open (MyFile)
'do something here
MyFile = Dir()
Loop
End Sub
It depends how you are naming the worksheets you create from the CSV files. You could add all the worksheets to a collection and use a For...Each loop to execute the entire search and concatenate procedure within that loop. Note that you'd have to explicitly define the first sheet name as this won't change through successive loops:
Option Explicit
Sub test()
Dim i As Long
Dim LastRow As Long
Dim Columns()
Dim frontSheet as Worksheet
Dim wSheets as New Collection
Dim ws as Worksheet
Set frontSheet = Sheets("name of front sheet")
'Add all your CSV sheets to wSheets using the .Add() method.
For Each ws in wSheets
Columns = Array("Column1", "Column2", "Column3")
'Find Columns by Name
For i = 0 To 2
Columns(i) = ws.Rows(1).Find(What:=Columns(i), LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False).Column
Next i
'Debug.Print Columns(0)
'Debug.Print Columns(1)
'Debug.Print Columns(2)
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
frontsheet.Cells(i, 1) = ws.Cells(i, Columns(0)) & "_" & ws.Cells(i, Columns(1)) & "_" & ws.Cells(i, Columns(2))
Next i
Next ws
End Sub
It's often slow and labourious to open CSV files in excel but VBA can read them as text files using a TextStream. Furthermore, file scripting objects let you work with files and directories directly. Something like this might be a better approach if you don't need to keep the files in a worksheet afterwards:
Sub SearchFoldersForCSV()
Dim fso As Object
Dim fld As Object
Dim file As Object
Dim ts As Object
Dim strPath As String
Dim lineNumber As Integer
Dim lineArray() As String
Dim cols() As Integer
Dim i As Integer
Dim frontSheet As Worksheet
Dim frontSheetRow As Integer
Dim concatString As String
Set frontSheet = Sheets("name of front sheet")
frontSheetRow = 1
strPath = "C:\where-im-searching\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strPath)
For Each file In fld.Files
If (Right(file.Name, 3) = "csv") Then
Debug.Print file.Name
Set ts = file.OpenAsTextStream()
lineNumber = 0
Do While Not ts.AtEndOfStream
lineNumber = lineNumber + 1
lineArray = Split(ts.ReadLine, ",")
If (lineNumber = 1) Then
'We are at the first line of the .CSV so
'find index in lineArray of columns of interest
'Add extra ElseIf as required
For i = LBound(lineArray) To UBound(lineArray)
If lineArray(i) = "Column 1" Then
cols(1) = i
ElseIf lineArray(i) = "Column 2" Then
cols(2) = i
ElseIf lineArray(i) = "Column 3" Then
cols(3) = i
End If
Next i
Else
'Read and store the column of interest from this
'row by reading the lineArray indices found above.
concatString = ""
For i = LBound(cols) To UBound(cols)
concatString = concatString & lineArray(i) & "_"
Next i
concatString = Left(concatString, Len(concatString) - 1)
frontSheet.Cells(frontSheetRow, 1).Value = concatString
frontSheetRow = frontSheetRow + 1
End If
Loop
ts.Close
End If
Next file
End Sub
You can find more information on FileSystemObject and TextStream here.
In the code below what I am trying to achieve is that the code searches for the files that are entered in column range F in the given path which is "D:\Checksheets\". I am still learning the FSO and would greatly appreciate any help.
Sub Test()
Dim FSO As Object
Dim FSO_Folder As Object
Dim FSO_file As Object
Dim path As String
Dim sheetref As String
Dim nextform As String
Dim row As Integer
Dim col As Integer
row = 8
col = 6
sheetref = Sheets("Sheet1").Cells(row, col)
'nextform = sheetref
path = "D:\Checksheets\"
Do Until Sheets("Sheet1").Cells(row, col) = "END"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO_Folder = FSO.GetFolder(path)
For Each FSO_file In FSO_Folder.Files
If FSO_file.Name = sheetref Then
MsgBox "done" & path
Else
End If
row = row + 1
Next
Loop
End Sub
The FSO has a built in FileExists method:
...
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim sht As Worksheet, cell As Range
Set sht = Sheets("Sheet1")
Do
Set cell = sht.Cells(row, col)
If cell.Value = "END" Then Exit Do
If FSO.FileExists(path & cell.Value) Then
MsgBox "done " & cell.Value
End If
row = row + 1
Loop
You can remove the FSO code entirely and replace the FileExists call with the built-in Dir$ function:
If Len(Dir$(path & cell.Value)) Then
Thanks to Alex I was able to get the code working. In case someone has similar issue, below is the code:
Sub test()
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim sht As Worksheet, cell As Range
Dim row As Integer
Dim col As Integer
Dim path As String
path = "D:\Checksheets\"
row = 1
col = 6
Set sht = Sheets("Sheet1")
Do
Set cell = sht.Cells(row, col)
If cell.Value = "END" Then Exit Do
If cell.Value <> "" Then ' checks for any empty cells
FSO.FileExists (path)
MsgBox "file exists"
Else
End If
row = row + 1
Loop
End Sub
So I was trying to create a list of excel files in a folder (file name and path) and then use a For loop to copy and paste a specified worksheet for all of the files listed into a specified worksheet in the excel workbook that contains the macro. So far everything works except for the fact that the same file keeps getting copied and pasted over instead of all the files. The macro loops for the correct number of times, but it's not using all the excel files.
Here's the code:
First part for listing the files in the folder
Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Administration\Time Sheets")
i = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 2) = objFile.Name
'print file path
Cells(i + 1, 3) = objFile.Path
i = i + 1
Next objFile
End Sub
and this is the part for the loop
Private Sub btn_PullData()
'Declared Variables
Dim wbk As Workbook
Dim i As Integer
Dim StartAt As Integer
Dim EndAt As Integer
Dim CopyPath As String
Dim CopyPathRow As Integer
Dim iRow As Integer
'Ranges
StartAt = 1
EndAt = Val(ThisWorkbook.Worksheets("LeaveReport").Range("A1"))
CopyPathRow = 3
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
iRow = 3
'Loop de loop
For i = StartAt To EndAt
Application.ScreenUpdating = False
Set wbk = Workbooks.Open(CopyPath)
Sheets("TIMESHEET").Select
Range("C12:S34").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Pastebin").Select
Range("a" & iRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
iRow = iRow + 39
CopyPathRow = CopyPathRow + 1
wbk.Close True
Next i
Sheets("Pastebin").Select
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Timesheet Data Imported"
End Sub
Based on the source of the error, i.e. same file being used, I'm guessing the issue lies with the part that has this:
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
and is "supposed" to update in the For loop via this:
CopyPathRow = CopyPathRow + 1
Move the line
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
Inside the loop, that value of CopyPath is never being changed, but the value of CopyPathRow is.
Edit: I wouldn't call this recursion either.