Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\test"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Dim nextRow As Integer
Dim wsTotal As Worksheet
Set wsTotal = basebook.Worksheets("sheet1")
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
'open file
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
With wsTotal
'activate if you want (optional)
'.Activate
'copy all the data on the sheet
mybook.Worksheets(1).UsedRange.Copy
'find the next empty row
nextRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
'select if desired (optional)
'.Cells(NextRow, 1).Select
'paste the data
.Cells(nextRow, 1).PasteSpecial (xlPasteAll)
'turn off copy mode
Application.CutCopyMode = False
'Do you really want to change the worksheet name?
'.Name = mybook.Name
End With
'close file
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End SubintCtr = 1
For Each each txtbx in TextboxCollection
intCtr = intCtr + 1
txtboxArray(intCtr) = txtbx.text
NextSub Add_Vendor_Columns()
Dim R As Range
Dim WS As Worksheet
Dim WB As Workbook
Dim LastCol As Long
Set WB = ActiveWorkbook
Sheets("All Data").Copy Before:=Sheets(2)
ActiveSheet.Name = "VENDOR COLUMNS"
Range("A:A,E:E,G:U").Delete Shift:=xlToLeft
Cells.Select
ActiveWorkbook.Worksheets("VENDOR COLUMNS").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("VENDOR COLUMNS").Sort.SortFields.Add Key:= _
Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("VENDOR COLUMNS").Sort
.SetRange Range("A1:D" & Cells(Rows.Count, "A").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("A1:D" & Cells(Rows.Count, "A").End(xlUp).Row).RemoveDuplicates Columns:=1, Header:= _
xlYes
Columns("E:BZ").NumberFormat = "$#,##0.00"
Range("E1:BZ1").NumberFormat = "@"
Set R = Range("E1")
'This will cause a problem if I save the macro in my PERSONAL.XLSB workbook.
'How would i write this line so it is looking at worksheets in the ActiveWorbook?
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "All Data" Then
If WS.Name <> "VENDOR COLUMNS" Then
R.Value = WS.Name
Set R = R(1, 2)
End If
End If
Next WS
'I tried to find the last column with data for use in copying my formula
'to the last used column. Haven't been able to make it work yet.
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'This is my failed attempt to tell the vlookup to look in the ActiveWorkbook,
'whatever the name, on the sheet named in cell E1. I get an "Application
'DEfined or Object Defined error. No luck figuring this out yet.
'I rimeed the line for testing purposes
'Range("E2").FormulaR1C1 = _
"=VLOOKUP(RC1,INDIRECT(" & ActiveWorkbook & "&R1C&""'!$B:$T""),11,FALSE)"
'Same formula as above, but this would not work if the Workbook were named something else.
'I can't figure how to make the indrect vlookup work in the ActiveWorkbook, no matter
'what the name of the workbook is.
Range("E2").FormulaR1C1 = _
"=VLOOKUP(RC1,INDIRECT(""'[PM Vend (Test).xlsm]""&R1C&""'!$B:$T""),11,FALSE)"
Range("E2").Copy
'Run-time Error 1004. Method "range" of object "Global" failed.
'I am trying to get the script to paste the formula I just entered in cell E2
'over to the last used column. I rimmed the line for testing purposes.
'Range("E2:" & LastCol & "2").Select
'The line below call out the specific range for this test, but wouldn't work if there
'were more columns on the worksheet.
Range("E2:H2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.Copy
'I need the line below to copy the formulas just entered down to the
'last used row and last used column. I know the formula to paste to the
'last used row, but no idea how to do both. This is why I dimmed LastCol
'at the beginning, and tied to set it later, but I still can't make it work
'in my script.
Range("E2:H7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Range("A1").Select
End Sub