I have a excel sheet with 2 columns
Contact Status Max Probability
80-Opp Closed Won
0-NC Closed Won
40-Pending 30-Connect
10-Working 20- Engagement
80-Opportunity 30-Connect
40-Pending 10- Engagement
I need to check if the no in contact status ie the numeric value before '-' is less than numeric value in max probabilty before '-', then i need the whole value of max probability update the contact status field
For eg.
10-Working 20- Engagement
10-Working should be replaced by 20- Engagement
OR
We can have 20- Engagement in a new column if the above mentioned conditioned is satisfied, if replacing the contact Status column is difficult
How can achieve this?
This little macro will do the trick. Just change Row to the starting row and ColA/B to the two columns you want to use.
Note that GetNum returns -1 if there is no number at the start which, in this implementation, means no copying. It was unclear what you wanted to do tith Closed Won so I chose the safest option. If you do want it copied, just return a huge number instead of -1.
Option Explicit
Function GetNum(s As String) As Integer
If Mid(s, 1, 1) < "0" Or Mid(s, 1, 1) > "9" Then
GetNum = -1
Else
GetNum = Val(s)
End If
End Function
Sub Macro1()
Dim Row As String
Dim ColA As String
Dim ColB As String
ColA = "A"
ColB = "B"
Row = "2"
While Range(ColA & Row).Value <> ""
If GetNum(Range(ColA & Row).Value) < GetNum(Range(ColB & Row).Value) Then
Range(ColA & Row).Value = Range(ColB & Row).Value
End If
Row = CStr(Val(Row) + 1)
Wend
End Sub
This was tested on:
to generate:
This macro will do:
Sub a()
ColumnContSt=1
ColumnMaxProb=2
i = 1
While (Cells(i, 2) <> "")
colB = Cells(i, ColumnMaxProb)
colA = Cells(i, ColumnContSt)
posB = InStr(1, colB, "-")
posA = InStr(1, colA, "-")
If (posB <> 0 And posA <> 0) Then
intColB = CInt(Mid(colB, 1, posB - 1))
intColA = CInt(Mid(colA, 1, posA - 1))
If (intColA < intColB) Then
Cells(i, 1) = Cells(i, 2)
End If
End If
i = i + 1
Wend
End Sub
Just change ColumnContSt = 1 and ColumnMaxProb = 2 for your actual column NUMBERS ie. A=1, B=2, etc.
HTH!
If you are flexible about the actual data, the easiest way to do this is to make two columns (can be hidden in some far away sheet):
0 NC
10 Engagement
30 Connect
...
And then use VLOOKUP(CELL_WITH_PROBABILITY, REGION_WITH_TABLE, 2, true). So if you put my small 3 element table in the upper corner of a sheet and probability in C1, it'd look like VLOOKUP(A1:B3, C1, 2, true)
Related
Thanks to some wonderful people here on StackOverflow I have almost completed the code for my scheduling template generator! I just have three more things I would like to add that I am having some trouble with.
Current Breakdown: I have two sheets - "2 - Staff Listing" and "X - Template"
-The Values in in the staff listing sheet are a column of staff names beginning in Cell D9
-Then the Staff values are transferred to the template sheets starting in Cell B6
-There is a drop-down menu in the template sheet in Cell C2 where you can select which template you want to make just as an example it could read 5 Week or 5 Week with AM/PM
-Based on this Key I have it repeating each staff member's names X amount of times (5 in this case) and double that if AM/PM is selected so 10 times in this case
What I am hoping to still achieve:
-In the template sheet I would like column C to be the week number and column D to show AM/PM.
-So, for a 5 week AM/PM Template you would have Column C staring in cell C6 list Week 1, Week 1, Week 2, Week 2, up to Week 5. So, once for each week in the Key if it is AM/PM it should appear twice once for AM and once for PM.
-Then I would like it to list AM starting in cell D6 and then go PM and just keep repeating for the length of the names in column B. Additionally, if it is not an AM/PM template then I would like to hide column D.
Below is the code I currently have.
Sub populate_Template()
Worksheets("X - Template").Range("B6:K1000").ClearContents
Dim SourceData As Range
Set SourceData = Sheets("2 - Staff Listing").Range("D9")
Dim RepititionCell As Range
Set RepititionCell = Sheets("X - Template").Range("C2")
Dim Destination As Range
Set Destination = Sheets("X - Template").Range("B6")
Dim lr As Long
Dim arr As Variant
With SourceData.Parent
lr = .Cells(.Rows.count, SourceData.Column).End(xlUp).Row
arr = .Range(SourceData, .Cells(lr, SourceData.Column)).Value
End With
Dim repetition As Long
If Right(RepititionCell, 5) = "AM/PM" Then repetition = Split(RepititionCell.Value, " ")(0) * 2 Else repetition = Split(RepititionCell.Value, " ")(0)
Dim newarr() As String
ReDim newarr(1 To (lr - SourceData.Row + 1) * repetition, 1 To 1)
Dim count As Long
count = 0
Dim i As Long
For i = LBound(arr) To UBound(arr)
Dim y As Long
For y = 1 To repetition
count = count + 1
newarr(count, 1) = arr(i, 1)
Next y
Next i
Destination.Resize(UBound(newarr) - LBound(newarr) + 1).Value = newarr
End Sub
First you need to dim newarr to have three columns instead of one:
ReDim newarr(1 To (lr - SourceData.Row + 1) * repetition, 1 To 3)
Then your For y Next loop should fill in those other two columns. You can use the Mod operator to determine if you're on an odd or even row.
For y = 1 To repetition
Count = Count + 1
newarr(Count, 1) = arr(i, 1)
'if you're doubling up. You may want to put this in a Boolean variable
'to reduce code duplication
If Right(RepititionCell, 5) = "AM/PM" Then
'if it's an odd number
If y Mod 2 = 1 Then
newarr(Count, 2) = "Week " & (y + 1) / 2
newarr(Count, 3) = "AM"
Else 'even number
newarr(Count, 2) = "Week " & y / 2
newarr(Count, 3) = "PM"
End If
Else
'not doubling up, so y is the week number and nothing in column D
newarr(Count, 2) = "Week " & y
End If
Next y
Finally, you have to change your write line to account for the new columns
Destination.Resize(UBound(newarr, 1), UBound(newarr, 2)).Value = newarr
I got rid of the LBound part of the Resize because you're starting at 1 anyway. It's less robust if you happen to start your array at some other number. But between the likelihood that would happen and the improved readability, I think it's better.
New to the forum and hope someone can help.
Create a function to loop through a set of data row by row for sorting.
Firstly need to check if column 1 is not equal to 9999. If not insert into the appropriate row using column 1 as the sort criteria. If it equals 9999 then insert into the appropriate spot using column 3 and column 2.
The problem I'm encountering is that some row and not sort. I think its because as I'm cutting and pasting the row is missed. Below is my code and the sample data
Sub insertionTableSort()
'PURPOSE: loop through all employee and apply the sort as follows:
'1) Seniority <> 9999 Seniority number
'2) Seniority = 9999 sort start date then employee number
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = ThisWorkbook.Worksheets("Roster Applications")
Set tbl = ws.ListObjects("RosterRequest") '## modify to your table name.
Set tblRow = tbl.ListRows
'Loop Through Every Row in Table
For x = 2 To tbl.Range.Rows.Count - 1
'Debug.Print x & ", " & tbl.DataBodyRange(x, 1).Value, tbl.DataBodyRange(x, 2).Value, tbl.DataBodyRange(x, 4).Value
For y = 2 To tbl.Range.Rows.Count
'seniroity = 9999
If tbl.DataBodyRange(x, 1) = 9999 Then
'sort by start date then Staff Num
If tbl.DataBodyRange(x, 4) < tbl.DataBodyRange(y - 1, 4) And tbl.DataBodyRange(x, 2) < tbl.DataBodyRange(y - 1, 2) Then
tbl.ListRows(x).Range.Cut
tbl.ListRows(y - 1).Range.Insert
Exit For
End If
Else
'seniroity <> 9999
'sort by seniority
If tbl.DataBodyRange(x, 1) < tbl.DataBodyRange(y - 1, 1) Then
tbl.ListRows(x).Range.Cut
tbl.ListRows(y - 1).Range.Insert
Exit For
End If
End If
Next y
Next x
End Sub
sample data after running the above
sorts well until this point where row 2 should be before row 1 and there are other examples
Data initially sort by Register No.
Errors highlighted in yellow
Finished Sort
In Excel, I have many products with different sizes listed in columns, such that the sizes "10x10 cm", "11x11 cm" and "15x15 cm" belongs to Product A, etc.
In some other cells, I am selecting a product (either Product A, Product B, or Product C) and a size.
I want, for each of the other products, to determine which size is closest to the selected product:
I don't know how to solve this. One solution might be to remove all non-numeric characters from the strings and add the two values on each side of the "x" and then select the size with the lowest absolute difference from the sum of the selected size.
But I guess it would be easier to do a mapping and use a VLOOKUP to choose the first found size in a given column.
However, the problem is that I do not only have 3 products with a few different sizes, but rather 15 different products with 10 different sizes, so I don't know how to do a mapping in a clever way.
1) Creating a lookup table with the values extracted for each product,
Source sheet:
Code:
Sub lookup()
Dim i As Long, j As Long, prod As Integer, str As String
prod = InputBox("Enter Number of Products")
Sheets.Add.Name = "LookupSheet"
j = 1
For i = 1 To prod
Columns(i).Copy Sheets("LookupSheet").Cells(1, j)
j = j + 2
Next i
For j = 1 To prod * 2 Step 2
For i = 2 To Sheets("LookupSheet").Cells(Rows.Count, j).End(xlUp).Row
str = Replace(Replace(Sheets("LookupSheet").Cells(i, j), " ", ""), "cm", "")
Sheets("LookupSheet").Cells(i, j + 1) = Left(str, InStr(str, "x") - 1) _
* Mid(str, InStr(str, "x") + 1, 999)
Next i
Next j
End Sub
This simple code creates a lookup sheet with the corresponding values. The code ignores any spaces present between the texts.
LookupSheet:
Since you have 15 different products, run this macro to extract the lookup data. This should be a one time activity unless you have additional products.
2) Assuming you enter the product and dimensions to F5 and F6, i would suggest you to data validation with dropdowns to select from the list,
3) Using a worksheet_change event, detect for changes in F5 and F6,
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String, result As Integer, i As Long
'F5 and F6 contains Product and Size repectively
If (Target.Address = "$F$5" Or Target.Address = "$F$6") _
And Range("F5") <> "" And Range("F6") <> "" Then
str = Replace(Replace(Range("F6"), " ", ""), "cm", "")
result = Left(str, InStr(str, "x") - 1) * Mid(str, InStr(str, "x") + 1, 999)
j = 8
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i) <> Range("F5") Then
Range("E" & j) = Cells(1, i)
j = j + 1
End If
Next i
End If
End Sub
This code automatically populated the rest of the product types in the column E,
4) The variable result would contain the product/area of the value that you provide in F6. The only task pending would be to loop through the lookup sheet to find the nearest match. The Algorithm is below,
Algorithm:
Compare cell F5 with the data in row 1 of lookup sheet (need to loop)
If they are equal, ignore and move to next value. If not, need to loop the immediate next column to find the next match, and populate the result in the corresponding cell in source sheet.
Algorithm for column wise looping is below,
Steps:
diff = cell.value - result
if diff < 0 then multiply diff by -1
loop:
nextdiff = nextcell.value - result (multiply by -1 if negative)
if nextdiff < diff then
diff = nextdiff
end if
end loop:
The cell value with the least difference would be your best match for that particular product type.
Bit lengthier explanation, hope this helps.
Hello again stackoverflow. My question should be fairly simple; How do you return a series of numbers from a mixed column of numbers and text?
I have something analogous to;
Text
5
Text
1
Text
Text
4
What I want from this, in another worksheet, is;
5
1
0 (if two rows of text are next to each other, I'd like to return 0)
4
Thanks for any assistance.
This spreadsheet lists containers and their contents. The first text in the series is an identifying marker. The second is how many items are in the container, the third is a smaller container within the first (I don't care how many items are in that one, just if it is present or not).
Column A (Sheet1)
Box
5
Bag
Box
1
Bag
Box
Bag
Box
4
Bag
The input is copy/pasted from a program and cannot be altered. What I want to do is, on another spreadsheet, say; Box has 5 pieces, 1 bag. Represented as;
Row 1 (Sheet2)
Box 5 1
The easiest way I can think of doing this would be to use the column NEXT to this column and have the following formula (assuming your data starts in cell A1):
=IF(ISNUMBER(A1),A1,IF(NOT(ISNUMBER(A2)),0,""))
Then drag that formula down the length of your "helper column" and then filter it for non-blanks.
Hope this is a good enough answer for what you're trying to achieve...
Sub Boxes_and_stuff()
Dim j As Byte
Dim ThisPage As Worksheet, TargetPage As Worksheet
Dim NewBook As Workbook
Set ThisPage = ThisWorkbook.ActiveSheet
Set NewBook = Workbooks.Add ' or you can address an existing file with workbooks.open(filename)
Set TargetPage = NewBook.Worksheets(1) ' you can also decide the sheet where you want to write your values (here by default is the first excel's "tab")
j = 1 ' cells' scanner
Do Until IsEmpty(ThisPage.Cells(j, 1))
If ThisPage.Cells(j, 1).Text = "Box" Then
' if "Box" is found scan cell below to find bags or numbers
If ThisPage.Cells(j + 1, 1).Text = "Bag" Then TargetPage.Cells(1 + j, 1) = "Box 0 1" ' if only a bag is found
If ThisPage.Cells(j + 1, 1).Text = "Box" Then TargetPage.Cells(1 + j, 1) = "Box 0 0" ' if nothing is inside a box and another box comes next (I'm assuming that "0" items will never show)
If IsNumeric(ThisPage.Cells(j + 1, 1)) Then ' if a number shows...
If (ThisPage.Cells(j + 2, 1)).text = "Bag" then '... the next can be bag
TargetPage.Cells(1 + j, 1) = "Box " & ThisPage.Cells(j + 1, 1) & " 1"
Else '...or not
TargetPage.Cells(1 + j, 1) = "Box " & ThisPage.Cells(j + 1, 1) & " 0"
End If
End If
End If
j = j + 1
Loop
End Sub
I want to merge the values in column B if Duplicates exist in Column A
A B
123 A
123 B
123 C
456 D
456 E
789 F
My output should look like this
A B
123 A B C
456 D E
789 F
I have a large amount of data and it is hard to do it manually ,So u guys have any idea to do it in macros in Excel?
Any help will be appreciated..Thanks in Advance
I'd cheat, and use formulas as follows;
1) Sort by column A
2) In col C, add a formula to test if the current one is last (assuming there's a header, put this in C2
=if(A2<>A3,TRUE,FALSE)
Now, this should only be true for the last cell in a series of same ID's
3) in Col D, add a formula for concatenating if the ID's are the same,
=if(A2=A1,D1&" "&B2,B2)
4) Filter on column C to show only the last cell in each series.
Cheers.
In case you want the resultant data in the same cells the original data existed ie not in Cell 10, then you have to store the source data in a two dimensional array. Then from the array we have use the above code to insert the data in the same place the original data existed. Here goes the listing to accomplish the task:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim names(2 To 7, 2)
For i = 2 To 7
names(i, 1) = Cells(i, 1)
names(i, 2) = Cells(i, 2)
Next
On Error Resume Next:
Sheet1.Cells.Clear
cnt = 2
For i = 2 To 7
strg = strg + names(i, 2)
If names(i + 1, 1) <> names(i, 1) Then
Cells(cnt, 1) = names(i, 1)
Cells(cnt, 2) = strg
cnt = cnt + 1
strg = ""
End If
Next
End Sub
Please note that I have declared names array with two dimesnions to store the data. Then the array is searched to get the result.
You can use the following macro:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
cnt = 10
For i = 2 To 7
strg = strg + Cells(i, 2)
If Cells(i + 1, 1) <> Cells(i, 1) Then
Cells(cnt, 1) = Cells(i, 1)
Cells(cnt, 2) = strg
cnt = cnt + 1
strg = ""
End If
Next
End Sub
The requested data will be printed from Cells 10