S
Sid Kaul
I am trying to learn how to VBA code and this is what I am to do... Please help if you can.
My objective is to: Find the relevant records that contains Input User ,"Unit Cost" from current Worksheet-"SalesOrders"
1-Input a "Project Name" (new Workbook)
2-Input a "Unit Cost" value,
3-Loop the process so we can input multiple "Unit Cost"s
4-Collect all the worksheets in a the "Project Name" workbook
I don't understand how I can fix my code...
Any help will be appreciated.
Sub Button1_Click()
Dim cellofInterest As String
Dim response As String, projectName As String
Dim newWb As Workbook
Dim result As Integer, newWbPath As String
Dim newSheet As String
Dim allSheets() As String
Dim count As Integer, i As Integer
Dim thisWb As Workbook
Application.DisplayAlerts = False
Set thisWb = ThisWorkbook
With thisWb
count = 0
projectName = InputBox("Enter project name: (leave blank to abort)", "Project Name")
response = "response"
Do While response <> ""
'Get the input from the user
response = InputBox("Enter the unit cost to search for: (leave blank to stop)", "Enter Unit Cost")
'Create a new worksheet with a copy of the current sheet
newSheet = response
'If the user entered blank, just exit
If (response = Empty) Then
GoTo endloop
End If
'Try to copy the sheet over
result = CopySheet("SalesOrders", newSheet)
If (result = 0) Then
'6 is the column number
.Sheets(newSheet).ListObjects(1).Range.AutoFilter Field:=6, Criteria1:=response
'Add the sheet to our array
ReDim Preserve allSheets(count)
allSheets(count) = newSheet
'Increment our sheet count
count = count + 1
Else
GoTo endloop
End If
'Set focus to the master sheet in case the user wants to enter more things to search
.Sheets("SalesOrders").Activate
Loop
endloop:
'Now that we have all our sheets, let's copy our workbook
newWbPath = CopyWorkbook(projectName)
With thisWb
'Now delete all sheets from the old workbook
For i = LBound(allSheets) To UBound(allSheets)
.Sheets(allSheets(i)).Select
.Sheets(allSheets(i)).Delete
Next i
.Sheets("SalesOrders").Activate
End With
End With
Application.DisplayAlerts = True
End Sub
Function CopySheet(originalSheetName As String, newSheetName As String) As Integer
Dim result As Integer
On Error GoTo errhandler
With ThisWorkbook
Dim MySheetName As String
.Sheets(originalSheetName).Copy After:=.Sheets(originalSheetName)
ActiveSheet.Name = newSheetName
End With
result = 0
CopySheet = result
Exit Function
errhandler:
result = -1
CopySheet = result
End Function
Function CopyWorkbook(newWbName As String) As String
Dim result As Integer
Dim newWbFilename As String
On Error GoTo errhandler
newWbFilename = thisWb.Path & "\" + newWbName + ".xls"
ThisWorkbook.SaveAs newWbFilename, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:=""
CopyWorkbook = newWbFilename
ThisWorkbook.Close savechanges:=True
Exit Function
errhandler:
MsgBox "Error " + Err.Number + "occurred!" + vbNewLine + Err.Description, vbCritical, "Error Trapped"
CopyWorkbook = Empty
End Function
My objective is to: Find the relevant records that contains Input User ,"Unit Cost" from current Worksheet-"SalesOrders"
1-Input a "Project Name" (new Workbook)
2-Input a "Unit Cost" value,
3-Loop the process so we can input multiple "Unit Cost"s
4-Collect all the worksheets in a the "Project Name" workbook
I don't understand how I can fix my code...
Any help will be appreciated.
Sub Button1_Click()
Dim cellofInterest As String
Dim response As String, projectName As String
Dim newWb As Workbook
Dim result As Integer, newWbPath As String
Dim newSheet As String
Dim allSheets() As String
Dim count As Integer, i As Integer
Dim thisWb As Workbook
Application.DisplayAlerts = False
Set thisWb = ThisWorkbook
With thisWb
count = 0
projectName = InputBox("Enter project name: (leave blank to abort)", "Project Name")
response = "response"
Do While response <> ""
'Get the input from the user
response = InputBox("Enter the unit cost to search for: (leave blank to stop)", "Enter Unit Cost")
'Create a new worksheet with a copy of the current sheet
newSheet = response
'If the user entered blank, just exit
If (response = Empty) Then
GoTo endloop
End If
'Try to copy the sheet over
result = CopySheet("SalesOrders", newSheet)
If (result = 0) Then
'6 is the column number
.Sheets(newSheet).ListObjects(1).Range.AutoFilter Field:=6, Criteria1:=response
'Add the sheet to our array
ReDim Preserve allSheets(count)
allSheets(count) = newSheet
'Increment our sheet count
count = count + 1
Else
GoTo endloop
End If
'Set focus to the master sheet in case the user wants to enter more things to search
.Sheets("SalesOrders").Activate
Loop
endloop:
'Now that we have all our sheets, let's copy our workbook
newWbPath = CopyWorkbook(projectName)
With thisWb
'Now delete all sheets from the old workbook
For i = LBound(allSheets) To UBound(allSheets)
.Sheets(allSheets(i)).Select
.Sheets(allSheets(i)).Delete
Next i
.Sheets("SalesOrders").Activate
End With
End With
Application.DisplayAlerts = True
End Sub
Function CopySheet(originalSheetName As String, newSheetName As String) As Integer
Dim result As Integer
On Error GoTo errhandler
With ThisWorkbook
Dim MySheetName As String
.Sheets(originalSheetName).Copy After:=.Sheets(originalSheetName)
ActiveSheet.Name = newSheetName
End With
result = 0
CopySheet = result
Exit Function
errhandler:
result = -1
CopySheet = result
End Function
Function CopyWorkbook(newWbName As String) As String
Dim result As Integer
Dim newWbFilename As String
On Error GoTo errhandler
newWbFilename = thisWb.Path & "\" + newWbName + ".xls"
ThisWorkbook.SaveAs newWbFilename, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:=""
CopyWorkbook = newWbFilename
ThisWorkbook.Close savechanges:=True
Exit Function
errhandler:
MsgBox "Error " + Err.Number + "occurred!" + vbNewLine + Err.Description, vbCritical, "Error Trapped"
CopyWorkbook = Empty
End Function