November 20, 2014, 11:06 am
Hey All,
I have the following code that works great but, I need it to run automatically when I switch between two sheets in a workbook. Does anyone know of any ways to tweak the code so that it runs automatically? I've tried Worksheet_change event but, cant seem to make it work.
Thanks
Sub hurows()
BeginRow = 5
EndRow = 94
ChkCol = 4
For RowCnt = BeginRow To EndRow
If Cells(RowCnt, ChkCol).Value > 0 Then
Cells(RowCnt, ChkCol).EntireRow.Hidden = False
Else
Cells(RowCnt, ChkCol).EntireRow.Hidden = True
End If
Next RowCnt
End Sub
↧
November 21, 2014, 9:10 am
Hello all,
I'm having a strong problem with a workbook I need to save in both shared (MultiUserEditing = True) and protected state. In such a workbook I need to run some vba macros to activate or inhibit some auto-filters...
The solution on a non-shared workbook is quite simple: simply protect the worksheet HMI with
Code:
wks.Protect UserInterfaceOnly:=True
and it's done...
Almost done, because the UserInterfaceOnly attribute is not saved! (Don't ask me why, but this is explicitly stated in the Worksheet.Protect help). Thus, it shall be re-applied when the workbook is opened (like wks.Protect UserInterfaceOnly:=True in the Workbook_Open callback) in order to get the same protection behaviour and having my auto filters working well with my macros.
A bit complex, but that's fine however.
BUT when the workbook is protected, then shared, it's pretty different ! Indeed, (0) on a shared workbook, the protection cannot be changed. This means that when I save my workbook, (1) I loose the UserInterfaceOnly:=True attribute of the protection and when I reopen it later, (2) I cannot restore it because the workbook is shared (thus protection cannot be modified)...
I feel a bit tricked with circling problem... (0) prevents me to restore the protect UserInterfaceOnly attribute but (0) doesn't prevent that attribute to be lost...
Any advice ?
Thanks !
↧
↧
November 21, 2014, 9:17 am
Hello All,
I have been studying VBA intently for a few weeks now but needing it for a practical purpose as soon as possible and am needing help. I get several emails per week with Excel files that I save into a particular folder automatically through an Outlook Macro. Once a week I would like to take all of the workbooks and worksheets within them, and save them into a specific single workbook on different worksheets. The problem is when I added in the portion of code that copies and pastes the individual worksheets (Not just the workbooks). I assume it is a problem with my Variables as I only have a basic understand of variables.
Basically what I need this code to do is:
1. Allow me to choose which workbooks I want to open and loop through them. (Seems to be working)
2. Loop through each Worksheet in each Workbook selected (Unsure if Works)
3. Copy Each worksheet (Cell Data Only), into a new worksheet on my "Master Pull Emailed Files.xlsm" workbook (Does Not Work)
4. Name Each Worksheet tab with the value of Cell A4 on that particular worksheet. (Optional)
Here is what I currently have:
Sub ImportData()
Dim Filenames As Variant
Dim i As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks("Master Pull Emailed Files.xlsm")
Application.ScreenUpdating = False
Filenames = Application.GetOpenFilename(Title:="Open File(s)", MultiSelect:=True)
For i = 1 To UBound(Filenames)
Workbooks.Open Filenames(i)
'*************************Line Below is where I am getting the error (on the very first time it runs through)
For Each ws In wb1.Worksheets
If ws.Visible = True Then
ws.Copy After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next ws
Workbooks.Open Filenames(i)
ActiveWorkbook.Close SaveChanges:=False
Worksheets.Add
Next i
End Sub
If anyone can explain what I seem to be missing or have mis-recorded, I would love to learn so I can avoid this problem both now and in the future. Thank you.
↧
November 21, 2014, 9:22 am
Hello! I tried searching for this and didn't find anything. Not even sure if I'm searching right.
I have a macro that creates a list of all sheet names in Column A of one sheet called Report. I want each cell (with the sheet name listed) to trigger another macro to export that particular sheet to a PDF. (I already have a macro that will export any given sheet as a PDF.) Because the list of sheet names will be different over time, it wouldn't work to hard program each cell to call a specific macro that has its sheet name hard-coded. In fact, I don't even know how to pass the text of a cell to a macro as a variable.
Here is the macro I found and am using in the code for my Report sheet. It successfully runs the macro with the hard-coded reference:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then Call ExportPDF
End Sub
And here is the macro in Module 1 that exports a specific sheet to a PDF: (the ws variable is what needs to be set to the text of the cell that gets clicked on)
Code:
Sub ExportPDF()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = Worksheets("TueB.616_")
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
MsgBox "PDF file has been created."
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
So (1) how do I pass the text as a variable, and (2) how would I make it apply to the whole list regardless of length?
Thanks!
↧
November 21, 2014, 9:27 am
I have been working on creating a macro that would automatically send an email based on the date in a specific column. After trying myself unsuccessfully I began searching online and found this post:
http://forums.techguy.org/business-a...-due-date.html. Here you can find pretty much the exact code I was looking for written by XCubed. I adopted that code to fit my worksheet and was able to get almost everything to work (
Example Workbook.xlsm). The problem I am running into is that the column I am referencing does not always have a date in it. Sometimes this column will have "TBD" or "ASAP" written in it and there is also blank rows used as separators. I am trying to find a way to use the same macro and include some sort of logical requirement that will run the code without getting an error. Basically I want it to ignore cells that aren't dates (both text and blank cells) and move on to the next row. Is there a way to accomplish that?
↧
↧
November 21, 2014, 9:34 am
Hi,
I am trying to hide the checkboxes based on a dropdown selection. I have attached a worksheet as an example.
I do not want the checkboxes to appear when the sheet is initially launched. Once we make a selection in the drop down (Either one device, two device, three device, Device in production) only then the checkboxes should appear and once we reset the dropdown back to " Select PS Engagement" the check boxes should disappear.
i.e. when the dropdown value is between (one device, two device, three device, device in production) the checkboxes should appear and should be unchecked so that i am able to check them.
but when the value is : "Select PS Engagement" the checkboxes should disappear/hide.
Thanks
↧
November 21, 2014, 9:36 am
Hello,
I am using the following code to copy a value from one cell to another. The two names in quotes are named ranges in the worksheet.
Range("Transaction_Price").Cells(1, 1).Value = Range("Price").Cells(1, 1).Value
The code works except that the target cell contains a rounded version of the source. So 53.0308 copies to 53.0300. There is no rounding or truncation in the code, and the number formats on the worksheet are more than enough decimal places.
I created a similar procedure with a new spreadsheet, but didn't get the erroneous behavior. So this seems to be something particular to my workbook / worksheet. Does anybody have any ideas?
Thanks!
Michael
↧
November 21, 2014, 9:38 am
Hi,
I have created below macro for time stamp.. it is not working please some one help or assist..
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim workrng1 As Range
Dim Rng As Range
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
'Sheet1.Unprotect Password:="TEST"
Set WorkRng = Intersect(Application.ActiveSheet.Range("M:M"), Target)
Set workrng1 = Intersect(Application.ActiveSheet.Range("N:N"), Target)
A = 12
B = 3
'On Error GoTo Error
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If WorkRng = "Completed" Then
' MsgBox "Unable to overwrite"
Rng.Offset(0, A).Value = Now
Rng.Offset(0, A).NumberFormat = "mm/dd/yyyy hh:mm:ss"
Rng.Offset(0, 1).Value = ""
'Rng.Offset(0, 2).Value = Now
'Rng.Offset(0, 2).NumberFormat = "mm/dd/yyyy hh:mm:ss"
'PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Unprotect
If Not Rng.Offset(0, 3).Value = "" Then
Rng.Offset(0, 4).Value = Now
Rng.Offset(0, 4).NumberFormat = "mm/dd/yyyy hh:mm:ss"
End If
ThisWorkbook.Save
Else
If WorkRng = "Rejected Duplicate" Then
Rng.Offset(0, A).Value = Now
Rng.Offset(0, A).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If WorkRng = "Rejected Completed" Then
Rng.Offset(0, A).Value = Now
Rng.Offset(0, A).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If WorkRng = "Clarification Needed - Requestor/Approver" Then
Rng.Offset(0, B).Value = Now
Rng.Offset(0, B).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If WorkRng = "Clarification Needed- Onsite" Then
Rng.Offset(0, B).Value = Now
Rng.Offset(0, B).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If workrng1 = "1St followup" Then
Rng.Offset(0, 6).Value = Now
Rng.Offset(0, 6).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If workrng1 = "2nd followup" Then
Rng.Offset(0, 7).Value = Now
Rng.Offset(0, 7).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If workrng1 = "3rd followup" Then
Rng.Offset(0, 8).Value = Now
Rng.Offset(0, 8).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If workrng1 = "1St Clarfication" Then
Rng.Offset(0, 6).Value = Now
Rng.Offset(0, 6).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If workrng1 = "2nd Clarfication" Then
Rng.Offset(0, 7).Value = Now
Rng.Offset(0, 7).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
If workrng1 = "3rd Clarfication" Then
Rng.Offset(0, 8).Value = Now
Rng.Offset(0, 8).NumberFormat = "mm/dd/yyyy hh:mm:ss"
ThisWorkbook.Save
Else
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
'Error:
'MsgBox "YOu are trying to overwrite"
End If
Next
'Next
End If
Application.EnableEvents = True
End Sub
regards
Jack
↧
November 21, 2014, 9:43 am
I have an excel workbook (name ul.xlsm) that everytime I close it I need it to save as a "ul.htm" and put in to the file "C:\Users\White Sign Company\Dropbox\UL\UL.htm" any ideas?
This saves it but when you open the .htm it shows a bunch of code.
Code:
ChDir "C:\Users\White Sign Company\Dropbox\UL"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\White Sign Company\Dropbox\UL\UL.htm", FileFormat:=xlHtml, _
ReadOnlyRecommended:=False, CreateBackup:=False
↧
↧
November 21, 2014, 9:44 am
Hi All,
Kindly look into the attached excel and please explain the given codes about ranges and array
↧
November 21, 2014, 10:02 am
Hey people!
I have a bit of a weird problem here and since I am a VBA newbie I thought I'd post my question here.
I have a userform that is populated with horizontal rows of checkboxes. The amount of checkboxes is based on a number the user puts in. The amounts of rows is based on what catagories the user puts in. A user can put in up to 10 catagories, which forms 10 lines of checkboxes on the userform. Now... when the user clicks "next" the read out of the checkboxes has to be saved to a table on a sheet, corresponding with the checkboxes lay out, in 1's and 0's.
What I have so far is almost everything, except for the fact that the read out of the checkboxes is all in thesame row on the sheet where the read out is saved, while I want it to correspond with the amount of rows of checkboxes on the form. (Gets complicated to explain...)
In simpler terms... If my user form looks like this
Naamloos.jpg
I want the read out to have thesame amount of rows and columns. Also... If a user decides not to put in category 5, which creates a blank line, it should skip a line in the read out table.
This is my code so far.
Code:
Private Sub UserForm_Initialize()
With Me
.ScrollBars = fmScrollBarsHorizontal
.ScrollWidth = .InsideWidth * 1.4
End With
ActiveSheet.Range("D1").Select
If IsEmpty(ThisWorkbook.Sheets(3).Range("A1")) Then
Else
Label1.Caption = Blad3.Range("A1").Value
Dim chk As Control
Dim idx As Integer
For idx = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx, True)
chk.Visible = True
chk.Left = (100 + (idx - 1) * (chk.Height + 15))
chk.Top = 44
chk.Caption = idx
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A2")) Then
Else
Label2.Caption = Blad3.Range("A2").Value
Dim chk2 As Control
Dim idx2 As Integer
For idx2 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk2 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx2, True)
chk2.Visible = True
chk2.Left = (100 + (idx2 - 1) * (chk2.Height + 15))
chk2.Top = 68
chk2.Caption = idx2
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A3")) Then
Else
Label3.Caption = Blad3.Range("A3").Value
Dim chk3 As Control
Dim idx3 As Integer
For idx3 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk3 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx3, True)
chk3.Visible = True
chk3.Left = (100 + (idx3 - 1) * (chk3.Height + 15))
chk3.Top = 92
chk3.Caption = idx3
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A4")) Then
Else
Label4.Caption = Blad3.Range("A4").Value
Dim chk4 As Control
Dim idx4 As Integer
For idx4 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk4 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx4, True)
chk4.Visible = True
chk4.Left = (100 + (idx4 - 1) * (chk4.Height + 15))
chk4.Top = 116
chk4.Caption = idx4
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A5")) Then
Else
Label5.Caption = Blad3.Range("A5").Value
Dim chk5 As Control
Dim idx5 As Integer
For idx5 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk5 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx5, True)
chk5.Visible = True
chk5.Left = (100 + (idx5 - 1) * (chk5.Height + 15))
chk5.Top = 140
chk5.Caption = idx5
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A6")) Then
Else
Label6.Caption = Blad3.Range("A6").Value
Dim chk6 As Control
Dim idx6 As Integer
For idx6 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk6 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx6, True)
chk6.Visible = True
chk6.Left = (100 + (idx6 - 1) * (chk6.Height + 15))
chk6.Top = 164
chk6.Caption = idx6
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A7")) Then
Else
Label7.Caption = Blad3.Range("A7").Value
Dim chk7 As Control
Dim idx7 As Integer
For idx7 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk7 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx7, True)
chk7.Visible = True
chk7.Left = (100 + (idx7 - 1) * (chk7.Height + 15))
chk7.Top = 188
chk7.Caption = idx7
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A8")) Then
Else
Label8.Caption = Blad3.Range("A8").Value
Dim chk8 As Control
Dim idx8 As Integer
For idx8 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk8 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx8, True)
chk8.Visible = True
chk8.Left = (100 + (idx8 - 1) * (chk8.Height + 15))
chk8.Top = 212
chk8.Caption = idx8
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A9")) Then
Else
Label9.Caption = Blad3.Range("A9").Value
Dim chk9 As Control
Dim idx9 As Integer
For idx9 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk9 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx9, True)
chk9.Visible = True
chk9.Left = (100 + (idx9 - 1) * (chk9.Height + 15))
chk9.Top = 236
chk9.Caption = idx9
Next
End If
If IsEmpty(ThisWorkbook.Sheets(3).Range("A10")) Then
Else
Label10.Caption = Blad3.Range("A10").Value
Dim chk10 As Control
Dim idx10 As Integer
For idx10 = 1 To Range("D1", ActiveCell.End(xlToRight)).Count
Set chk10 = Invoerdata3.Controls.Add("Forms.CheckBox.1", idx10, True)
chk10.Visible = True
chk10.Left = (100 + (idx10 - 1) * (chk10.Height + 15))
chk10.Top = 260
chk10.Caption = idx10
Next
End If
End Sub
Private Sub Volgende_Click()
Dim Ctrl As Control
For Each Ctrl In Controls
If TypeName(Ctrl) = "CheckBox" Then
sn = sn & IIf(Ctrl, 1, 0) & "|"
End If
Next Ctrl
With Sheets("Blad3").Range("B1").Resize(, UBound(Split(sn, "|")))
.Value = Split(sn, "|")
.Value = .Value
End With
Unload Me
End Sub
The difficulty is that the amount of categories as well as the amount of checkboxes is dynamically.
Hopefully someone can guide me a bit into the right direction.
↧
November 21, 2014, 10:34 am
Hello,
I'm having a little difficulty creating this macro. I know how to open a folder, and I know how to open a file from a folder...
...but what if I want the user to click a button to active the macro, then they are prompted to enter in the final folder name of the folder he/she wishes to open through the use of a pop up?
I assume that I first need to create a UserForm1 with the text field for the user to enter the exact name of the folder, and a button to proceed.
Untitled.png
Steps:
Sub()
Click button
Prompt Opens
User enters folder name
Selects button to proceed
Macro Opens Folder ("Network path \" + folder name "\"
Window folder
User can double click on excel file to launch.
End sub
↧
November 21, 2014, 10:36 am
I am tracking times
and I need the program to execute some
Code
say every second
how do I write an 'event'? Can I?
Thanks
↧
↧
November 21, 2014, 10:38 am
Hi,
Could someone please help me to make a for loop for a Conditional Formatting macro?
Below you see what I'm gona do. But I dont want that to be applied just to G6. I need it in G6-G200 but the "6" in $H6>=$G6 must be change with the row number.
Like G7 would get: Formula1:="=$H7>=$G7"
Code:
Range("G6").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$H6>=$G6"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With
Thanks for the help!
↧
November 21, 2014, 10:49 am
Hello,
I am trying to lock cell B4 if a value is entered in B3, lock cell C3 if a value is entered in C4 and so on. I have attached an example to better explain what I am looking for. Any help would be greatly appreciated.
Thank you!!
Jill
↧
November 21, 2014, 10:53 am
This calculation is working up to row 12. But I need to calculate up to blank row. what is the problem here. please help me. here is the code
Sub ScoreMacro()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
Dim Rank As Integer
Dim Clients As Integer
Dim Products As Integer
Dim Margin As Double
Dim RankScore As Integer
Dim ClientScore As Integer
Dim ProductScore As Integer
Dim MarginScore As Integer
Dim CurScore As Integer
Dim TotalScore As Integer
Dim TotalScorePercent As Double
Dim MaxScore As Integer
Dim StartRow As Integer, i As Integer
Dim ColumnBeforeStart As Integer, j As Integer
'number of columns to be added before Product Rank column
ColumnBeforeStart = 2
StartRow = 7
i = StartRow
j = ColumnBeforeStart + 1
While ws.Cells(i, j) <> ""
' set initial score for current row
TotalScore = 0
'Get current Rank
If Not (IsNumeric(ws.Cells(i, j))) Then
MsgBox "Rank in row " & i & " is not numeric value"
Exit Sub
End If
Rank = ws.Cells(i, j)
'Process Rank rules
If (Rank >= 0) And (Rank <= 100) Then
CurScore = 35
ElseIf (Rank >= 101) And (Rank <= 500) Then
CurScore = 25
ElseIf (Rank >= 501) And (Rank <= 1000) Then
CurScore = 20
ElseIf (Rank >= 1001) And (Rank <= 5000) Then
CurScore = 15
Else
CurScore = 0 '????????????
End If
' Set RankScore
ws.Cells(i, j + 1) = CurScore
TotalScore = TotalScore + CurScore
'Get current Clients Value
If Not (IsNumeric(ws.Cells(i, j + 2))) Then
MsgBox "Clients value in row " & i & " is not numeric value"
Exit Sub
End If
Clients = ws.Cells(i, j + 2)
'Process Clients rules
If (Clients >= 0) And (Clients <= 10) Then
CurScore = 20
ElseIf (Clients >= 51) And (Clients <= 100) Then
CurScore = 5
ElseIf (Clients >= 101) And (Client <= 300) Then
CurScore = -10
ElseIf (Clients > 300) Then
CurScore = -20
End If
' Set ClientsScore
ws.Cells(i, j + 3) = CurScore
TotalScore = TotalScore + CurScore
'Get current Products Value
If Not (IsNumeric(ws.Cells(i, j + 4))) Then
MsgBox "Products value in row " & i & " is not numeric value"
Exit Sub
End If
Products = ws.Cells(i, j + 4)
'Process Products rules
If (Products < 1) Then
CurScore = 20
ElseIf (Products >= 1) And (Products <= 2) Then
CurScore = 10
ElseIf (Products >= 3) Then
CurScore = -15
End If
' Set ProductsScore
ws.Cells(i, j + 5) = CurScore
TotalScore = TotalScore + CurScore
'Get current Margin Value
If Not (IsNumeric(ws.Cells(i, j + 6))) Then
MsgBox "Margin value in row " & i & " is not numeric value"
Exit Sub
End If
Margin = ws.Cells(i, j + 6)
'Process Margin rules
If (Margin = 0) Then
CurScore = -30
ElseIf (Margin >= 0.01) And (Margin <= 0.1) Then
CurScore = -10
ElseIf (Margin >= 0.11) And (Margin <= 0.3) Then
CurScore = 10
ElseIf (Margin >= 0.31) And (Margin <= 0.5) Then
CurScore = 20
ElseIf (Margin >= 0.51) Then
CurScore = 25
End If
' Set MarginScore
ws.Cells(i, j + 7) = CurScore
TotalScore = TotalScore + CurScore
' add total score to current row
ws.Cells(i, j + 8) = TotalScore
' I suppose that maxScore is 100 = sum of all max points
' in each category
MaxScore = 100
' Get TotalScore in percents
TotalScorePercent = TotalScore / MaxScore
' add total score to current row
ws.Cells(i, j + 9) = TotalScorePercent
i = i + 1
Wend
End Sub
↧
November 22, 2014, 4:23 am
Hey guys, I'm really stuck with this one and it might be a bit complicated.
So, I've got this 5 year project for which i would need to create a function to calculate the cash-flows for every year and discount them and in the end, the function should retrieve the npv of the project.
The Function would have to take as inputs: the initial fixed cost of the project, the 1st year variable cost, the price, the 1st year demand, the number of years and the discount rate.
I also know that my variable cost per unit starts at 6000 and will be decreasing 5% each year for the life of the project.
My 1st year demand is fixed, let's say 50000 for a price of 15000, but with every 500 increase in price, the demand will decrease 1500.
So, basically my CF each year would be the price * demand - variable cost * demand. This would then have to be discounted using the rate that the user defined initially.
In the end, I would sum up all the discounted CFs and subtract the initial fixed cost, to get the NPV of my project. And that would be the result of my function.
Thanks in advance!!
↧
↧
November 22, 2014, 5:13 am
Hello members,
I've read all answers about the thread in
this page before opening a new thread, but ... .
I'd like to have the code insert rows where the dates are missing and assign "?" to them in column C (Value).
Could you please do consider all issues.
1. Datasets are in daily format and the duration is
not fixed but sequential ascending. (e.g. 1/1/1949 - 30/12/2010)
2. In a Msg Box, shows the number of inserted rows.
3. Values start from 3rd row and col B&C have different values.
11-22-2014 9-03-17 PM.png
Regards,
↧
November 22, 2014, 6:49 am
is there timer icon in Excel vba like vba6
↧
November 22, 2014, 6:50 am
This sub creates a desktop shortcut of the file in the workbook_open event. I do not want it to create the shortcut everytime workbook is opened, but cannot figure out the code for it to check. I have added the "IF" line to check if 1 is on the spreadsheet, but this is not good if someone deletes the shortcut from the desktop. Thanks in advance for any help provided!
Code:
Dim WSHShell
'If Environ(UserName) & "\Desktop\B620_09.xltm.lnk" = Empty Then
If Sheet26.Range("AD1").Value <> 1 Then
Set WSHShell = CreateObject("WScript.Shell")
Dim MyShortcut2, DesktopPath
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set MyShortcut2 = WSHShell.CreateShortCut(DesktopPath & "\B620_09.xltm.lnk")
Sheet26.Range("AD1").Value = 1
With MyShortcut2
.TargetPath = WSHShell.ExpandEnvironmentStrings(Environ("USERPROFILE") & "\Documents\B620_09.xltm")
.Save
End With
End If
↧