Applying master workbook VBA to 1000 files - excel

Following the instructions in this Stack Overflow question, I tried to run my macro with the following code:
Sub ay1()
Dim fileName, Pathname As String
Dim wb As Workbook
Pathname = "/Users/ayy/Downloads/Folder1/STATS1/"
fileName = Dir(Pathname & "*.csv")
Do While fileName <> ""
Set wb = Workbooks.Open(Pathname & fileName)
DoWork wb
wb.Close SaveChanges:=True
fileName = Dir()
Loop
End Sub
Sub DoWork(wb As Workbook)
With wb
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$191").AutoFilter Field:=3, Criteria1:="="
Range("C2:C190").Select
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$C$96").AutoFilter Field:=3
Range("E95").Select
ActiveWorkbook.Save
ActiveWindow.Close
End With
End Sub
I saved this in a "master workbook" that is macro-enabled in the same directory where all my .csv files are located. I clicked run macro and selected ay1.
This is not running on any of my files. I'm not getting any errors.

Using a With block: you need to tie your references to wb with a leading .
Sub DoWork(wb As Workbook)
With wb.Sheets(1)
.UsedRange.AutoFilter
.Range("$A$1:$C$191").AutoFilter Field:=3, Criteria1:="="
.Range("C2:C190").EntireRow.Delete
.Range("$A$1:$C$96").AutoFilter Field:=3
End With
wb.Save
wb.Close
End Sub

Related

Export csv separated by columns

I have an Excel with several sheets I want to export to csv delimited by columns.
When I run the code, it exports the files to csv but comma delimited, not column delimited as I export in csv.
Any help would be appreciated.
Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir (MyFilePath & "_csv") '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs ThisWorkbook.path & "\_csv\" & SheetName & ".csv", FileFormat:=xlCSV
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub
Thanks!
Edit: Screenshot that clarifies my problem.
https://imgur.com/a/mPn997B
Define FileFormat as xlText and the file will be TAB delimited, which you obviously are looking for.
f.ex.:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.SaveAs "c:\tmp\tabtest.csv", xlText
End Sub

Excel VBA Code stops running after Workbook Open

I have the following problem: After I start opening a workbook that I have just created, the code stops running with no error. Have anyone a solution how the rest of the code can be excuted?
Thanks in Advance!
Private Sub CommandButton3_Click()
On Error GoTo Eingabefehler
Application.DisplayAlerts = False
ActiveSheet.Select
Range("A1").Select
ActiveSheet.Paste
ThisWorkbook.Save
Dim strPath As String
Dim strName As String
UserForm1.Show
strPath = "C:\Users\Desktop\"
strName = Application.GetSaveAsFilename(InitialFileName:=strPath & ".xlsx", FileFilter:="XLSX-File (*.xlsx), *.xlsx")
ActiveWorkbook.SaveAs Filename:=strName, FileFormat:=xlOpenXMLWorkbook
Dim WbDatei1 As Workbook
Dim WbDatei3 As Workbook
Set WbDatei1 = ThisWorkbook
Set WbDatei3 = Workbooks.Open(strName) 'VBA Code stops working from here
For Each shp In WbDatei3.Sheets(1).Shapes
shp.Delete
Next
WbDatei3.Save
WbDatei1.Sheets(1).Select
Selection.Columns("F:F").EntireColumn.AutoFit
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(TIME(HOUR(RC[-2]-RC[-5]),MINUTE(RC[-2]-RC[-5]),SECOND(RC[-2]-RC[-5])),"""")"
[...]

How to save columns in .txt whit condition VBA

I'm a beginer with VBA and I'd like to know where I went wrong with my code.
Sub Worksheet_Calculate()
Application.EnableEvents = False
If
code
End If
Application.EnableEvents = True:
If Range("A3") <> Range("B4") Then
Columns("B1:F10000").Select
ChDir "C:\Users\Francesco\Desktop"
ActiveWorkbook.SaveAs:="C:\Users\Francesco\Desktop\TXT.txt", _
FileFormat:=xlTextMSDOS, CreateBackup:=False
End If
End Sub
My focus is: when the condition If Range("A3") <> Range("B4") is true,I'd like that vba creates a .txt.
Where I wrong?
Thank you in advance.
Try This:
Sub Worksheet_Calculate()
If Range("A3") <> Range("B4") Then
ActiveSheet.Range("B1:F10000").Select
ActiveWorkbook.SaveAs "C:\Users\Francesco\Desktop\TXT.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
End If
End Sub
As per your code you are saving the entire Worksheet. So i don't see any point of selecting the Columns.
Dim wb as workbook, wb1 as workbook
set wb = activeworkbook
set wb1 = application.workbooks.new
If Range("A3") <> Range("B4") Then
wb.activate
Columns("B1:F10000").copy
wb1.activate
range("A1").paste
ChDir "C:\Users\Francesco\Desktop"
wb1.SaveAs:="C:\Users\Francesco\Desktop\TXT.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
call wb1.close(false)
End If
Not tested.
Try this
Function SimpleWriteToText(ByVal FileName, ByVal strText, Optional Wtype = "output")
If Wtype = "output" Then
Open FileName For Output As #1
Else
Open FileName For Append As #1
End If
Print #1, strText;
Close #1
End Function
Usage
SimpleWriteToText ThisWorkbook.path & "\Text.txt", "Hello" ' Append
SimpleWriteToText ThisWorkbook.path & "\Text.txt", "Hello", "output" ' NewOne

Syntax error on Paste Special from ThisWorkbook to new workbook

First line of code works fine, second errors out with a syntax error. I want it to do the same thing as first line except paste values only.
ThisWorkbook.Sheets(1).Range(Range("A4"), Range("A4").End(xlDown)).Copy .Sheets(1).Range("A1")
ThisWorkbook.Sheets(1).Range(Range("G4"), Range("G4").End(xlDown)).Copy .Sheets(1).Range("B1").PasteSpecial xlPasteValues
Full code for the sub
Private Sub CommandButton1_Click()
With Workbooks.Add
ThisWorkbook.Sheets(1).Range(Range("A4"), Range("A4").End(xlDown)).Copy .Sheets(1).Range("A1")
ThisWorkbook.Sheets(1).Range(Range("G4"), Range("G4").End(xlDown)).Copy .Sheets(1).Range("B1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
.SaveAs "C:\Users\my username\Desktop\Macro Demo\output.xlsx"
Application.DisplayAlerts = True
.Close
End With
End Sub
Range("A4") and Range("A4").End(xlDown) may not belong to ThisWorkbook.Sheets(1) and you cannot define a range using cells from another worksheet.
Private Sub CommandButton1_Click()
Dim nwb As Workbook
Set nwb = Workbooks.Add
With ThisWorkbook.Sheets(1)
.Range(.Range("A4"), .Range("A4").End(xlDown)).Copy _
Destination:=nwb.Sheets(1).Range("A1")
With .Range(.Range("G4"), .Range("G4").End(xlDown))
nwb.Sheets(1).Range("B1").Resize(.Rows.Count, 1) = .Value
End With
End With
With nwb
Application.DisplayAlerts = False
.SaveAs "C:\Users\my username\Desktop\Macro Demo\output.xlsx"
Application.DisplayAlerts = True
.Close
End With
End Sub

Export multiple worksheets to CSV files in a specified directory

I'm trying to do the following:
Export/Copy particular sheets in the workbook (any sheet name that contains "Upload") to a particular file directory.
I don't want these worksheet names to change nor the workbook name to change.
The file-name is consistent for each worksheet, so it would be okay to replace the files in the directory whenever I run the macro. It is okay to have a dialog box that asks if I'm sure I want to replace each of the files.
I don't want the newly created CSVs or any other file to open.
Sub SheetsToCSV()
'Jerry Beaucaire (1/25/2010), updated (8/15/2015)
'Save each sheet to an individual CSV file
Dim ws As Worksheet, fPATH As String
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'automatically overwrite old files
fPATH = "C:\2015\CSV\" 'path to save into, remember the final \ in this string
For Each ws In Worksheets
ws.Copy
ActiveWorkbook.SaveAs Filename:=fPATH & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next ws
Application.ScreenUpdating = True
End Sub
You just need to add a simple loop through all worksheets and test the name.
Try this:-
Sub COPYSelectedSheetsToCSV()
Dim ws As Worksheet
'In case something goes wrong
On Error GoTo COPYSelectedSheetsToCSVZ
'Loop through all worksheets
For Each ws In ActiveWorkbook.Sheets
'Does the name contain "Upload"
If InStr(1, ws.Name, "Upload") > 0 Then
'Make the worksheet active
ws.Select
'Save it to CSV
ActiveWorkbook.SaveAs Filename:="/Users/reginaho/Desktop/Upload/" & ws.Name & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
End If
Next
COPYSelectedSheetsToCSVX:
'Clean up the memory usage
Set ws = Nothing
Exit Sub
COPYSelectedSheetsToCSVZ:
MsgBox Err.Number & " - " & Err.Description
Resume COPYSelectedSheetsToCSVX
End Sub

Resources