I'm trying to create a task scheduler in excel. I'll have a start month and an end month, but I'd like to fill in the periods in between. For instance, right now my table looks like this:
+--------+-------+-----+-------+-----+-----+-----+-----+-----+
| Task | Jan | Feb | Mar | Apr | May | Jun | Jul | Aug |
+--------+-------+-----+-------+-----+-----+-----+-----+-----+
| Task A | Start | | | | End | | | |
+--------+-------+-----+-------+-----+-----+-----+-----+-----+
| Task B | | | Start | End | | | | |
+--------+-------+-----+-------+-----+-----+-----+-----+-----+
| Task C | Start | | | | | End | | |
+--------+-------+-----+-------+-----+-----+-----+-----+-----+
For "Task A", I'd like to have the cells in between Jan - May have some text like "Work" or something similar.
So the final table would like this:
+--------+-------+------+-------+------+------+-----+-----+-----+
| Task | Jan | Feb | Mar | Apr | May | Jun | Jul | Aug |
+--------+-------+------+-------+------+------+-----+-----+-----+
| Task A | Start | Work | Work | Work | End | | | |
+--------+-------+------+-------+------+------+-----+-----+-----+
| Task B | | | Start | End | | | | |
+--------+-------+------+-------+------+------+-----+-----+-----+
| Task C | Start | Work | Work | Work | Work | End | | |
+--------+-------+------+-------+------+------+-----+-----+-----+
This is a dynamically changing table, so hard-coding the text in there isn't an option.
Update:
Because this table is dynamic, this table is linked to a table on another tab. It pulls the data with a simple formula "=Sheet1!B2" dragged across the table.
This is assuming that your data starts on cell A1. You will need to change the for loops for the row and column counter if it does not.
Sub fillTask()
Dim intRow As Integer, intStartFlg As Integer
Dim mySht As Worksheet
Set mySht = Sheets("Sheet1")
intStartFlg = 0
'get last row
intRow = mySht.Cells(mySht.Rows.Count, "A").End(xlUp).Row
'loop through each task
For i = 2 To intRow
'Clear previous loop
For j = 2 To 13
If mySht.Cells(i, j) <> "Start" Or mySht.Cells(i, j) <> "End" Then mySht.Cells(i, j).ClearContents
Next j
'loop through each month
For j = 2 To 13
If mySht.Cells(i, j) = "end" Then Exit For
If intStartFlg = 1 Then mySht.Cells(i, j) = "Work"
If mySht.Cells(i, j) = "Start" Then intStartFlg = 1
Next j
intStartFlg = 0
Next i
End Sub
Related
This is a follow up to my previous question (Retrieving information of OLEObjects from Workbook with VBA)
Scenario: I am trying to retrieve data from a worksheet. The data might be normal strings or number or might be encased in check boxed (checked or not).
Data example:
+---------+-------+------------------+------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+------+------------------+
| value x | rfd | checkbox for rfd | nfd | checkbox for nfd |
+---------+-------+------------------+------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+------+------------------+
Obs: In this example the "checkbox for rfd/nfd" is a normal checkbox (either form or activex), and depending on the item in that sheet, either might be selected.
Objective: What I am trying to do is read the worksheet in 2 steps: First read all the data that is directly called, so I use the code:
Sub Test_retrieve()
' this will get all non object values from the sheet
Dim array_test As Variant
Dim i As Long, j As Long
array_test = ThisWorkbook.Sheets(1).UsedRange
For i = 1 To ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ThisWorkbook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
ThisWorkbook.Sheets(2).Cells(i, j) = array_test(i, j)
Next j
Next i
End Sub
to get:
+---------+-------+------------------+------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+------+------------------+
| value x | rfd | | nfd | |
+---------+-------+------------------+------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+------+------------------+
Next I am trying to reach all the objectives/shapes in my worksheet. I used the following code to get name, value (checked of not) and location of all activex objects:
Sub getavticeboxvalue()
' this will get the names and values (as binary) of all the activex controlbox objects in the sheet
Dim objx As Object
Dim i As Long
i = 1
For Each objx In ThisWorkbook.Sheets(1).OLEObjects
If objx.Object.Value = True Then
ThisWorkbook.Sheets(3).Cells(i, 1).Value = 1
ThisWorkbook.Sheets(3).Cells(i, 2).Value = objx.Name
ThisWorkbook.Sheets(3).Cells(i, 3).Value = objx.BottomRightCell.Address
ElseIf objx.Object.Value = False Then
ThisWorkbook.Sheets(3).Cells(i, 1).Value = 0
ThisWorkbook.Sheets(3).Cells(i, 2).Value = objx.Name
ThisWorkbook.Sheets(3).Cells(i, 3).Value = objx.BottomRightCell.Address
End If
i = i + 1
Next objx
End Sub
Which yields something like:
+-------+-----------+----------+
| value | name | location |
+-------+-----------+----------+
| 0 | checkbox1 | $C$2 |
+-------+-----------+----------+
| 1 | checkbox2 | $E$2 |
+-------+-----------+----------+
I would then proceed to feed the values (1s and 0s), to the first table, in the place where the checkboxes originally where (location).
Issue: When I try the same procedure for Form Control (instead of activex), I have less options, and although I can look for them (ThisWorkbook.Sheets(1).Shapes.Type = 8) I cannot find their name or location.
Question: Is there a way to find their name and location? Is there a more efficient way to reach the result?
Objective:
+---------+-------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+
| value x | rfd | 0 | nfd | 1 |
+---------+-------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+
Suppose I have a table like this in excel -
+-------------+----------+------------+
| Google Name | D11 Name | Entry |
+-------------+----------+------------+
| REN | MLR | |
| THU | SDT | |
| SIX | SDS | |
| HOH | HBH | |
| STR | ADS | |
| HEA | BRH | |
| PRS | PS | |
| STA | MLS | |
+-------------+----------+------------+
Now I will enter something in Entry column. If the value matches with Google Name value it should change to corresponding D11 Name value. Which means this -
+-------------+----------+------------+
| Google Name | D11 Name | Entry |
+-------------+----------+------------+
| REN | MLR | SIX -> SDS |
| THU | SDT | |
| SIX | SDS | |
| HOH | HBH | |
| STR | ADS | |
| HEA | BRH | |
| PRS | PS | |
| STA | MLS | |
+-------------+----------+------------+
If I enter SIX final entry will be SDS, -> is for explaining purpose only.
If you want to change a typed input to a values retrieved from a lookup, you need VBA and a Worksheet_Change event driven sub procedure.
Open the worksheet's private code sheet (right-click worksheet name tab and View Code) then paste in this code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
On Error GoTo sub_exit
Application.EnableEvents = False
Dim t As Range, m As Variant
For Each t In Intersect(Target, Range("C:C"))
m = Application.Match(t.Value2, Range("A:A"), 0)
If Not IsError(m) Then
t = Cells(m, "B").Value2
End If
Next t
End If
sub_exit:
Application.EnableEvents = True
End Sub
I have the following columns
12 A
11 M
12 B
12 C
11 A
9 M
13 N
11 M
12 C
11 B
15 M
I want to calculate median based on only Ms. I have done by selecting ranges.
I want to use columns rather than ranges. Is there any solution? Thanks for your help
If you have 2010 or later use this formula:
=AGGREGATE(17,6,(A:A/(B:B="M")),2)
If you have 2007 or earlier, try this array formula:
=MEDIAN(IF(B:B="M",A:A))
This is an array formula and must be confirmed with Ctrl-Shift-Enter.
Though the use of full column references will slow the calculation times because it will iterate through all the rows, all 1.04 million. It is good practice to limit the references to the max data range to help offset this drain. Change the C:C to something like $C$1:$C$10000 then it will loop only 10,000 times.
Well as a VBA user I love to use VBA, other can use your skill using formulas, and is completly right if you are good on formulas. Here is my answer and I hope help you.
Imagine you have this:
+----+------------+--------------------+---------------+
| 1 | Values (A) | Criteria Range (B) | Criteria ( C) |
+----+------------+--------------------+---------------+
| 2 | 14 | B | A |
| 3 | 1 | M | |
| 4 | 15 | A | |
| 5 | 15 | E | |
| 6 | 10 | A | |
| 7 | 3 | M | |
| 8 | 11 | A | |
| 9 | 8 | M | |
| 10 | 14 | A | |
| 11 | 5 | M | |
| 12 | 9 | M | |
| 13 | 10 | M | |
| 14 | 11 | N | |
| 15 | 9 | A | |
| 16 | 2 | M | |
| 17 | 15 | M | |
| 18 | 11 | A | |
| 19 | 12 | S | |
| 20 | 9 | M | |
| 21 | 11 | A | |
| 22 | 15 | V | |
+----+------------+--------------------+---------------+
And inside the cell E2 you have this =MedianIf($A$2:$A$22,$B$2:$B$22,C2) and the result must be 11
Because in a regular module of VBA you put this function.
Function MEDIANIF(RangeIf As Range, Criteria_Range1 As Range, Criteria1 As String) As Double
Dim i
Dim Counter
Dim tmp()
Dim subCouter
subCouter = 0
For Each i In Criteria_Range1
Counter = Counter + 1
If i.Value = Criteria1 Then
subCouter = subCouter + 1
ReDim Preserve tmp(1 To subCouter)
tmp(subCouter) = RangeIf(Counter)
End If
Next i
Dim a
MEDIANIF = Application.WorksheetFunction.Median(tmp())
End Function
And the function works like this:
RangeIF = is the range with the values that you want to get the MEDIAN
Criteria_Range1 = Is the range where you have all the criteria, is the same size as RangeIF
Criteria1 = Is the criteria you use to filter the data.
How about this low-tech solution:
In Column C, formulate: =IF(B2="M",A2,"") (in rows 2-12, based on your data, and assuming row 1 contains headers)
In cell D2 (or anywhere else), formulate: =MEDIAN(C:C)
I have to column of data (time A and time B) and I would like to find out for each data a in A if there is a value b in B that meets the criteria of b-a = +/−0.007. I am trying to use vlookup but I cannot specify the criteria of b-a = +/−0.007. Can I do this using vlookup or there is other ways to do it in excel? Many thanks in advance for help!
The data example is shown below.
+----------------+------------------+
| Time A | Time B |
+----------------+------------------+
| 0.000 | 0.000 |
| 1.001 | 1.001 |
| 1.852 | 1.852 |
| 2.725 | 2.729 |
| 3.356 | 3.359 |
| 4.061 | 4.070 |
| 4.423 | 4.431 |
| 4.634 | 4.642 |
| 4.750 | 4.637 |
| 5.390 | 5.398 |
| 5.788 | 5.788 |
| 6.515 | 6.522 |
| 7.010 | 7.010 |
| 7.672 | 7.500 |
| 8.017 | 7.900 |
| 8.073 | 8.200 |
+----------------+------------------+
You could use this VBA solution:
Sub main()
Dim i As Integer
Dim j As Integer
For i = 2 To 16
For j = 2 To 16
If Abs(Cells(j, 2) - Cells(i, 1)) < 0.007 Then
Cells(i, 3) = j
End If
Next j
Next i
End Sub
It in column C it outputs the matching row index from column B:
Program: Excel 2010
Experience Basic
Issue:
I have a large table of data with some "split cells" (first/last name & currency), this is how it is from the original data (copied & pasted from a webpage, the data is split in 2). I need to make a clean table with all data on 1 row, not 2. I have some sample data below, and then further down I have included how I want it to look like.
The original formatting is a HTML table, pulled from a database (which I do NOT have access to, however I can generate a CSV but that in itself is another question due to how it is setup.)
Assume: Data in (A1); there are more than the listed values & columns, and I will accept either formula OR VBA answers and lastly: Ignore the blank rows, they were inserted to show the difference between tables more clearly.
Original Data:
| Date | Transaction ID | Order Reference | Sender | Sender Email | Status | Payment Amount | Amount Paid |
|------------|----------------|-----------------|--------|--------------|--------|----------------|-------------|
| 17/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 12/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
Required Data: (notice the first/last are now on the same row as is the currency)
| Date | Transaction ID | Order Reference | Sender | | Sender Email | Status | Payment Amount | | Amount Paid | |
|------------|----------------|-----------------|--------|------|--------------|--------|----------------|-----|-------------|-----|
| 17/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 12/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
Thank you, have a great weekend.
[EDIT]
Note, none of these cells are merged, each cell is an individual, and the "last" & "AUD" need to be moved right & up.
This should work for you:
Public Sub ModData()
Dim colDate As Long
Dim colTrans As Long
Dim colOrder As Long
Dim colSender As Long
Dim colSenderEmail As Long
Dim colStatus As Long
Dim colPmtAmt As Long
Dim colPaid As Long
Dim r As Long
Dim ws As Worksheet
colDate = 1
colTrans = 2
colOrder = 3
colSender = 4
' col 5 reserved for inserted col
colSenderEmail = 6
colStatus = 7
colPmtAmt = 8
' col 9 reserved for inserted col
colPaid = 10
Set ws = ActiveSheet
Application.ScreenUpdating = False
' Add extra columns needed.
ws.Columns(colSender + 1).Insert Shift:=xlToRight
ws.Columns(colPmtAmt + 1).Insert Shift:=xlToRight
' Move data to same row.
For r = 2 To 12 Step 2
ws.Cells(r, colSender + 1).Value = ws.Cells(r + 1, colSender).Value
ws.Cells(r, colPmtAmt + 1).Value = ws.Cells(r + 1, colPmtAmt).Value
ws.Cells(r, colPaid + 1).Value = ws.Cells(r + 1, colPaid).Value
Next r
' Delete unnecessary rows.
r = 3
While ws.Cells(r - 1, 1).Value <> ""
ws.Cells(r, 1).EntireRow.Delete
r = r + 1
Wend
Application.ScreenUpdating = True
End Sub