Macro which should add a new Worksheet

jovi - Jul 21, 2016 at 04:48 AM
 Blocked Profile - Jul 22, 2016 at 03:21 PM
Hi guys, I have a question

So I have a VBA Code which pretty much does everything it should.
I can choose the CSV-Files, it deletes the columns that aren't needed and so on.

But now, I want to create a new Worksheet with this Macro, but I don't know how.
i know the code should be:
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
But i don't know where to put it into my code.

If someone could help me, this would be grate.

so here is the code:

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
#End If

Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_CSV_Files()
'For Excel 2000 and higher
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim CSVFileNames As Variant
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim Count As Variant
Dim bla As String
Dim status(3) As Variant
status(1) = "Opened"
status(2) = "In Progress"
status(3) = "Done"

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet(Application.DefaultFilePath)
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

CSVFileNames = Application.GetOpenFilename _
(filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)

If IsArray(CSVFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)

'Loop through the array with csv files
For Fnum = LBound(CSVFileNames) To UBound(CSVFileNames)

Set mybook = Workbooks.Open(CSVFileNames(Fnum))

'Copy the sheet of the csv file after the last sheet in
'basebook (this is the new workbook)
mybook.Worksheets(1).Copy After:= _
On Error Resume Next
ActiveSheet.Name = Right(CSVFileNames(Fnum), Len(CSVFileNames(Fnum)) - _
InStrRev(CSVFileNames(Fnum), "\", , 1))
On Error GoTo 0

mybook.Close savechanges:=False

'Unwrap Text in Cells
Cells.WrapText = False

'Delete the Columns that aren't needed

'Add Collumns which are needed
Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Value = "Date"

Count = Application.WorksheetFunction.CountIf(Range("A:A"), "*")
bla = InputBox("Date of Scan")
Range("D2:D" & Count).Value = bla

Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Value = "Service Now Incident"

Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F1").Value = "Status"

'Add to each cell in this Column a drop-down list
With Range("F2:F" & Count).Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, Formula1:=Join(status, ",")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


Next Fnum

'Delete the first sheet of basebook
On Error Resume Next
Application.DisplayAlerts = False
Application.DisplayAlerts = True
On Error GoTo 0


ChDirNet SaveDriveDir

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If

End Sub

1 reply

Blocked Profile
Jul 21, 2016 at 04:28 PM
Does this process of creating a new sheet, need to have the above process worked on it, or does the new sheet get data from the above process?
Hi ac3mark

Thanks for your reply to this post.
I managed to solve this issue by myself so this works now.

But maybe you can help me with this one:

The Code creates a new sheet for each CSV-File I choose.
But now I have to rename it, and delete the first 19 characters of the sheet name as well as the last 7.

I tried it with: ActiveSheet.Name = Mid(ActiveSheet.Name, 19, 3) #Because he name should be only the next three characters from the 19th character in the name.

I tried this everywhere in the code: in the For Loop, before the For Loop and after.
But it doesn't work.
Blocked Profile
Jul 22, 2016 at 03:21 PM
Initialize a variable with the ActiveSheet.Name, Then manipulate the variable. Then re-initialize the variable with the modified value. Give that a Try!