Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 2 years ago.
Improve this question
I am completely new to Excel VBA, and I'm trying to write code to do a simple task.
There are 3 Worksheets in an Excel: Summary, Discount, Price
Worksheet Summary contains data as below:
Dropdown (Data in B1 and B3):
Type: Supermarket,Hopcoms
Product:Dairy,Meat,Combo
Category:Chicken,Eggs,Eggs+Chicken
Worksheet Discount contains data as below:
Worksheet Price contains data as below:
Tasks:
User in Summary Sheet selects Data in B1:B3 through drop down list.
Based on the selection , Discount in % should be selected for corresponding combination from Discount Sheet
For Ex : If user selects Supermarket-Combo-Eggs+Chicken in Summary Sheet(from #1) , total discount availed should be 13%(as per Discount Sheet).
User navigates to Price sheet and enters data in Total Price column for each customer
When User clicks Calculate Discount button now 13% discount should be applied on Total Price for all customer and discount amount should be updated in Discount Availed column
Total Discount price provided to all customers should be updated next to T.Discount.
Apologies for any mistakes, could anyone please resolve this?
Please let me know for any questions
Test the next code, please. But before that, please insert another column in Price worksheet, between existing "Customer" (B:B) and "Total Price" (C:C) and name it "Price". There the user will fill the standard price (without any discount) and in "Total Price" the the price will be calculated applying the discount:
Sub TestApplyDiscount()
Dim shS As Worksheet, shD As Worksheet, shP As Worksheet, lastRowP As Long
Dim strType As String, strProd As String, strCat As String, i As Long, j As Long
Dim rowType As Long, rowProd As Long, rowCat As Long, disc As Double
Set shS = Worksheets("Summary")
Set shD = Worksheets("Discount")
Set shP = Worksheets("Price")
lastRowP = shP.Range("A" & Rows.count).End(xlUp).Row
strType = shS.Range("B1").value
strProd = shS.Range("B2").value
strCat = shS.Range("B3").value
With WorksheetFunction
rowType = .Match(strType, shD.Range("A1:A19"), 0)
rowProd = .Match(strProd, shD.Range("B" & rowType & ":B" & rowType + 8), 0)
rowProd = rowProd + rowType - 1
rowCat = .Match(strCat, shD.Range("C" & rowProd & ":C" & rowProd + 3), 0)
rowCat = rowCat + rowProd - 1
disc = shD.Range("D" & rowCat).value
End With
For i = 2 To lastRowP
shP.Range("E" & i).value = disc & "%"
shP.Range("D" & i).FormulaR1C1 = "=RC[-1]-(RC[-1]*RC[1])"
Next i
End Sub
I am waiting for some feedback...
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 2 years ago.
Improve this question
Is there a way to write this Excel Formula in VBA?
=SUM(
NUMBERVALUE(COUNTIF(SheetName!A:B,CONCATENATE((E3+1),(F3+1),G3,H3,I3,J3,$L$2))),
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3+1),F3,G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3+1),(F3-1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE(E3,(F3+1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE(E3,F3,G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE(E3,(F3-1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3-1),(F3+1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3-1),F3,G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3-1),(F3-1),G3,H3,I3,J3,$L$2)))))
please, is there a way I can write this formular in Excel VBA?
It concatenates cell values. e.g
X=cella1, X=cellb1 X=cellc1 + etc... and gives all possible combinations of these values X as Strings
The Countiffunction goes to a different excel sheet in that workbook, and selects a range and then counts the cells in that range, that meets the Strings condition, which is given to it as its second argument.
NumberValue then converts the strings to Integers.
Lastly it takes the sum of these Integers.
Try this code, please:
Dim sh As Worksheet, sh2 As Worksheet
Set sh = ActiveSheet
Set sh2 = Worksheets("SheetName") 'use here your real worksheet name
'Adapt here the cell where to formula to be dropped:
sh.Range("L3:L945").formula = "=SUM(NUMBERVALUE(COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3+1)," & _
"(F3+1),G3,H3,I3,J3,$L$2))),NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3+1)," & _
"F3,G3,H3,I3,J3,$L$2))))+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3+1),(F3-1)," & _
"G3,H3,I3,J3,$L$2))))+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE(E3,(F3+1),G3,H3," & _
"I3,J3,$L$2))))+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE(E3,F3,G3,H3,I3,J3,$L$2))))" & _
"+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE(E3,(F3-1),G3,H3,I3,J3,$L$2))))+NUMBERVALUE" & _
"((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3-1),(F3+1),G3,H3,I3,J3,$L$2))))+NUMBERVALUE" & _
"((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3-1),F3,G3,H3,I3,J3,$L$2))))+NUMBERVALUE" & _
"((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3-1),(F3-1),G3,H3,I3,J3,$L$2)))))"
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
I am looking for a macro that will insert rows based on cell values in column E. If the cells above and below have a difference more than 0.002, I want two rows inserted in between. Below is an example of what I would like to have the data to look like
EX.
Column E
42948.745
(Insert Blank (Row)
(Insert Blank Row)
42948.758
(Insert Blank (Row)
(Insert Blank Row)
42948.898
42948.900
42948.901
(Insert Blank (Row)
(Insert Blank Row)
42948.933
Even better if the code included a way to fill the cells in the blank row with + 0.001 from the above cell and -0.001 from the bottom cell. Ex.
42948.901
Insert 42948.902
Insert 42948.932
42948.933
Thank you so much as I have been trying to figure this out forever. I have many shortcuts but no solutions.
The following code will do what you want
Sub InsertBlankRowAndSetValue()
Dim yourColumn As String
Dim rowToStart As Integer
Dim nameOfYourSheet As String
Dim currentValue As Double
Dim previousValue As Double
'EDIT VALUES HERE
yourColumn = "E"
rowToStart = 1
nameOfYourSheet = "Name of your sheet"
With ThisWorkbook.Sheets(nameOfYourSheet)
'For each cell in the column from the end
For i = .Cells(.Rows.Count, yourColumn).End(xlUp).Row To rowToStart + 1 Step -1
currentValue = CDbl(.Range(yourColumn & i).Value)
previousValue = CDbl(.Range(yourColumn & i).Offset(-1, 0).Value)
'If the difference with the previous > 0.002
If ((currentValue - previousValue) > 0.002) Then
'Add rows and set values
.Rows(i).EntireRow.Insert Shift:=xlDown
.Range(yourColumn & i).Value = currentValue + 0.001
.Rows(i).EntireRow.Insert Shift:=xlDown
.Range(yourColumn & i).Value = previousValue + 0.001
End If
Next i
End With
End Sub
Explanations
Edit the name of your sheet in nameOfYourSheet = "Name of your sheet" to make it work.
I go through every value in your column starting from the bottom (less problems with index when you add a row above) and if the difference is more than 0.002 then I add a row and put +0.001 as it's value.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
i am beginner in excel vba i have huge list where the first name and last name in one column without any space or symbol and some name are in capital alphabet and some have no capital alphabet and they are the same column what would be the popossible macro to make space batween them...or any possible way....
thanks in advance....
Not reliable but will get you there with simple names. Select the range of names and run the macro.
Sub InsertSpacesInNames()
Dim pos As Long: pos = 0
Dim uc As Long: uc = 0
For Each cell In Selection
For i = 1 To Len(cell.Value)
If Asc((Mid(cell.Value, i, 1))) >= 65 And Asc((Mid(cell.Value, i, 1))) <= 90 Then
uc = uc + 1
pos = i
End If
Next i
If uc = 2 Then
cell.Value = Mid(cell.Value, 1, pos - 1) & " " & Mid(cell.Value, pos, Len(cell.Value))
End If
uc = 0
pos = 0
Next
End Sub
My output:
This macro will work fine if and only if:
you use it with simple names (no compound names like Jean-PierreLeCosteau which's desired output is Jean-Pierre LeCosteau)
the full name has two capital letters only.
Assuming you know the first name then simple example using formulas:
A B
1 AmandaWinslet = "Amanda" & " " & RIGHT(A1, LEN(A1) - LEN("Amanda"))) // result is Amanda Winslet
The VBA way of doing this would be:
Sub AddSpace()
Range("A1") = "Amanda" & " " & VBA.Right$(Range("A1"), Len(Range("A1")) - Len("Amanda"))
End Sub
You will need to loop over the list in VBA and make FirstName a variable. Your post assumes you have the first name from somewhere
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 9 years ago.
Improve this question
Could anyone give me advice on how to look up a row in a spreadsheet which matches two criteria, then change the data in specific Cells.
The data will be like this..
Reference Version date1 date2 date3
ABC1 1 11/12/2013
ABC1 2 31/12/2013
ABC2 1 12/12/2013
ABC3 1 12/12/2013
ABC1 3 01/01/2014
In VBA I wish to be able to find the row that matches the reference and the version number, then datestamp column 4 of that 1 unique row.
Any help would be really appreciated.
Many Thanks
Solving for a position for two criteria can be solved by this array formula (in this sample looking up ABC3 and 1 in A2:B6
This formula can be used in VBA to provide the position for the timestamp:
VBA Equivalent
Sub OneWay()
Dim lngRow As Long
lngRow = Evaluate("=MATCH(1,(A2:A6=""ABC3"")*(B2:B6=1),0)")
Cells(lngRow + 1, 4) = Now()
End Sub
or just:
Sub OneWay2()
lngRow = Cells(Evaluate("=MATCH(1,(A2:A6=""ABC3"")*(B2:B6=1),0)")+ 1, 4) = Now()
End Sub
Try this code:
Sub test()
Dim refToFind As String
Dim versToFind As String
refToFind = "ABC1"
versToFind = "1"
'address of first reference
Set Rng = Sheet1.Range("B2")
lastrow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row - Rng.Row
For i = 0 To lastrow
If CStr(Rng.Offset(i, 0).Value) = refToFind _
And CStr(Rng.Offset(i, 1).Value) = versToFind Then
Rng.Offset(i, 4) = Now
End If
Next i
End Sub