sparkerino
11-15-2019, 01:41 PM
Hello,
I have tried a ton of different codes, video tutorials and resources to try and run my code on all of the .xls files in a folder, and cannot get it to work. I know this should be trivial, and it's likely that my lack of experience with VBA is making me miss something obvious, so I really appreciate anyone's patient assistance with this.
I'm running Excel 2016 on a Mac running Mojave. I want to run the following code on the files in the path /Users/sara/Desktop/MatLab/Split Files/ . I just want it to open the file, run the macro, save/overwrite the original file, and close. Thank you for your help
Sub DataReorganization()
'Duplicating Sheet to TIPS
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "TIPS"
'Editing Columns
Sheets("TIPS").Select
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H3").Select
ActiveCell.FormulaR1C1 = "1"
Range("I3").Select
ActiveCell.FormulaR1C1 = "1"
Dim rng As Range
Dim sht As Worksheet
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row '
Set rng = Range("H4:H" & Lastrow)
rng.Formula = "=IF(A4=A3,H3,H3+1)"
Set rng = Range("I4:I" & Lastrow)
rng.Formula = "= IF(A4=A3,I3+1,1)"
Columns("H:I").Select
Selection.Copy
Columns("A:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Value = "Filo"
Range("B1").Value = "Time"
Range("C1").Value = "X"
Range("D1").Value = "Y"
Range("E1").Value = "Distance"
Range("F1").Value = "Velocity"
Range("G1").Value = "Intensity"
'Duplicating TIPS to IDENTIFIERS
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "IDENTIFIERS"
'Delete Time
Sheets("IDENTIFIERS").Select
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("E:H").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
ActiveWorkbook.Worksheets("IDENTIFIERS").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("IDENTIFIERS").Sort.SortFields.Add2 Key:=Range( _
"B2:B" & Lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("IDENTIFIERS").Sort
.SetRange Range("A:D")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim iCntr As Long
For iCntr = Lastrow To 1 Step -1
If Cells(iCntr, 2).Value <> "1" Then
Rows(iCntr).Delete
End If
Next
Range("A1").EntireRow.Insert
Range("A1").Value = "Filo"
Range("B1").Value = "Time"
Range("C1").Value = "X"
Range("D1").Value = "Y"
'Create Sheet BASES
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "BASES"
End Sub
'Save All
For Each Workbook In Workbooks
Workbook.SaveAs fileName:= _
"/Users/sara/Desktop/MatLab/Split Files/" & Workbook.Name, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Next
End Sub
I have tried a ton of different codes, video tutorials and resources to try and run my code on all of the .xls files in a folder, and cannot get it to work. I know this should be trivial, and it's likely that my lack of experience with VBA is making me miss something obvious, so I really appreciate anyone's patient assistance with this.
I'm running Excel 2016 on a Mac running Mojave. I want to run the following code on the files in the path /Users/sara/Desktop/MatLab/Split Files/ . I just want it to open the file, run the macro, save/overwrite the original file, and close. Thank you for your help
Sub DataReorganization()
'Duplicating Sheet to TIPS
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "TIPS"
'Editing Columns
Sheets("TIPS").Select
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H3").Select
ActiveCell.FormulaR1C1 = "1"
Range("I3").Select
ActiveCell.FormulaR1C1 = "1"
Dim rng As Range
Dim sht As Worksheet
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row '
Set rng = Range("H4:H" & Lastrow)
rng.Formula = "=IF(A4=A3,H3,H3+1)"
Set rng = Range("I4:I" & Lastrow)
rng.Formula = "= IF(A4=A3,I3+1,1)"
Columns("H:I").Select
Selection.Copy
Columns("A:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Value = "Filo"
Range("B1").Value = "Time"
Range("C1").Value = "X"
Range("D1").Value = "Y"
Range("E1").Value = "Distance"
Range("F1").Value = "Velocity"
Range("G1").Value = "Intensity"
'Duplicating TIPS to IDENTIFIERS
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = "IDENTIFIERS"
'Delete Time
Sheets("IDENTIFIERS").Select
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("E:H").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
ActiveWorkbook.Worksheets("IDENTIFIERS").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("IDENTIFIERS").Sort.SortFields.Add2 Key:=Range( _
"B2:B" & Lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("IDENTIFIERS").Sort
.SetRange Range("A:D")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim iCntr As Long
For iCntr = Lastrow To 1 Step -1
If Cells(iCntr, 2).Value <> "1" Then
Rows(iCntr).Delete
End If
Next
Range("A1").EntireRow.Insert
Range("A1").Value = "Filo"
Range("B1").Value = "Time"
Range("C1").Value = "X"
Range("D1").Value = "Y"
'Create Sheet BASES
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "BASES"
End Sub
'Save All
For Each Workbook In Workbooks
Workbook.SaveAs fileName:= _
"/Users/sara/Desktop/MatLab/Split Files/" & Workbook.Name, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Next
End Sub