I have a stacked column graph and i want to hide/show some of the categories on certain conditions. All solutions, i've found, work for series, but in need for categories.
Thank you in advance.
I recorded a macro while I filtered my chart to hide category 2, and here's what the recorder gave me:
ActiveChart.ChartGroups(1).FullCategoryCollection(2).IsFiltered = True
I found a workaround. However, maybe somebody has a more elegant solution, it would be much appreciated.
1st i swap series and categories.
chartSheet.ChartObjects("chart").Chart.PlotBy = xlColumns
2nd then i check which column is hidden and save an index for FullSeriesCollection. With a little convoluted way to get the sheet name and column address, where the data is located.
Dim i As Long, k As Long
Dim tmp() As Variant
Dim sh As String, col As String
For i = 1 To Sheet2.ChartObjects("tst").Chart.SeriesCollection.Count
If Worksheets(Split(Split(Sheet2.ChartObjects("tst").Chart.SeriesCollection(i).Formula, ",")(2), "!")(0)) _
.Range(Split(Split(Sheet2.ChartObjects("tst").Chart.SeriesCollection(i).Formula, ",")(2), ":")(1)).EntireColumn.Hidden = True Then
k = k + 1
ReDim Preserve tmp(1 To k)
tmp(k) = i
End If
Next i
3rd after that i run through all the hidden columns and hide the corresponding data. I couldn't combine 2nd and 3rd, because if any other column, then the last one, is hidden, vba gives an error. Since it tries to access SeriesCollection, which does not exits anymore.
For i = 1 To UBound(tmp)
chartSheet.ChartObjects("chart").Chart.FullSeriesCollection(tmp(i)).IsFiltered = True
Next i
4th and lastly i flip series and categories back around.
chartSheet.ChartObjects("chart").Chart.PlotBy = xlRows
Related
I have 2 sheets, Transfer Data and Keep List. My current code is below.
Dim cfind, cfind1, delete, c As Range
Dim x As String
Dim i, j As Integer
Set td = ThisWorkbook.Worksheets("Transfer Data")
Set delete = Range(cfind.Offset(0, 0), cfind.End(xlDown))
Set cfind = dl.Cells.Find(What:="Location Name", lookat:=xlWhole)
Set delete = Range(cfind.Offset(0, 0), cfind.End(xlDown))
j = td.Range("H2").End(xlDown).Row
For i = j To 1 Step -1
x = td.Cells(i, "H").value
Set cfind1 = delete.Find(What:=x, lookat:=xlWhole)
If cfind1 Is Nothing Then
td.Cells(i, "H").EntireRow.delete
End If
Next
So the idea of this is that whatever is on the Keep List (i.e. Column B on Keep List refers to Column H of Transfer Data, and if the value isnt on this Keep List, the entire row gets deleted.
My code works but it takes awhile, especially the initial run. for the rest of the column, I just re-use the code above and just adjusted the header name accordingly to what is on the Keep List, start with column B, then it works on the next list, which is Column C (Department Id).
Is there a more faster/efficient way to code this? Also there may be more columns added to the Keep List in the future, so flexibility to include future columns would also be helpful. The column headers for both tabs will be exactly the same but not necessarily in the same order.
Transfer Data
Keep List
I am wondering about a simple solution for reversing the filtered values. Although it seems to me to be an easy task, I have not had a success while researching on the internet.
The situation and problem: I have a table with multiple columns, and lot of rows (exact amount does not matter obviously) and I want to see what was not filtered in exactly one column. The problem is that I normally need to do a lot of clicking
For example - in the database of projects I have filtered the ones worth over 500 000 €, which are mine and are coming from a specific country. By one click I would like to see which ones are below 500 000 €) but are still mine and coming from a specific country.
Possible solutions which came to my mind:
Create a unique list of what is filtered, unfiltered, and create an unique list of full column, AdvanceFilter by the difference. (That's my white horse - it might work in my opinion)
Go through each filtering options and check/uncheck one by one.
Screenshot filters, transfer to text, create a unique values at the column, invert the filter in advanced filtering (very crazy idea, came out of desperation)
Somewhere easily take a list of what's filtered and inverted it by easy function (that was my initial thought but not working!)
Does anybody has an idea how to approach this situation?
I am able to try the VBA on my own so I would be happy if you can point me in the right direction. Of course I would welcome your thoughts in code too.
Here's an idea to toggle a numeric filter. It won't work with all numeric filters, but most of them. For instance, it won't work with Between, because that uses Criteria1 and Criteria2. But you could expand the code to account for that.
Also, it only really works on numeric filters. It will work on some text filters, but only if one criteria is applied.
Sub InvertNumericFilter()
Dim lFilter As Long
Dim lo As ListObject
Dim fltr As Filter
Dim aOper As Variant, aOpp As Variant
Dim i As Long
'aOpp is the opposite of the corresponding
'operator in aOper
aOper = Split("<> <= >= = < >")
aOpp = Split("= > < <> >= <=")
'Find which column you're in
Set lo = ActiveCell.ListObject
lFilter = ActiveCell.Column - lo.DataBodyRange.Column + 1
Set fltr = lo.AutoFilter.Filters(lFilter)
'if the first characters of the criteria are in aOper
'then swap them for aOpp
For i = LBound(aOper) To UBound(aOper)
If Left(fltr.Criteria1, Len(aOper(i))) = aOper(i) Then
lo.DataBodyRange.AutoFilter lFilter, Replace$(fltr.Criteria1, aOper(i), aOpp(i))
Exit For
End If
Next i
End Sub
Your example happened to be inverting a number, but if you want it to be universal (apply to nonnumerics), it would get a lot more complicated.
Update
This will invert value lists, but it makes some assumptions. For one, if you only have two values, it's not a value list, it's an xlOr operator. If you're using xlOr on some other type of field, it might cause problems.
Sub InvertFilter()
Dim lFilter As Long
Dim lo As ListObject
Dim fltr As Filter
Dim aOper As Variant, aOpp As Variant
Dim i As Long, j As Long
Dim dc As Scripting.Dictionary
Dim vaValues As Variant
'Find which column you're in
Set lo = ActiveCell.ListObject
lFilter = ActiveCell.Column - lo.DataBodyRange.Column + 1
Set fltr = lo.AutoFilter.Filters(lFilter)
'lists of values or just two values
If fltr.Operator = xlFilterValues Or fltr.Operator = xlOr Then
'get all the possible values and put in a dictionary
vaValues = lo.ListColumns(lFilter).DataBodyRange.Value
Set dc = New Scripting.Dictionary
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
If Not dc.Exists("=" & vaValues(i, 1)) Then
dc.Add "=" & vaValues(i, 1), "=" & vaValues(i, 1)
End If
Next i
'If it's more than two values
If IsArray(fltr.Criteria1) Then
'remove from dictionary
For i = LBound(fltr.Criteria1) To UBound(fltr.Criteria1)
If dc.Exists(fltr.Criteria1(i)) Then
dc.Remove fltr.Criteria1(i)
End If
Next i
Else
dc.Remove fltr.Criteria1
dc.Remove fltr.Criteria2
End If
'reapply filter
lo.DataBodyRange.AutoFilter lFilter, dc.Keys, xlFilterValues
ElseIf fltr.Operator = 0 Then
'aOpp is the opposite of the corresponding
'operator in aOper
aOper = Split("<> <= >= = < >")
aOpp = Split("= > < <> >= <=")
'if the first characters of the criteria are in aOper
'then swap them for aOpp
For i = LBound(aOper) To UBound(aOper)
If Left(fltr.Criteria1, Len(aOper(i))) = aOper(i) Then
lo.DataBodyRange.AutoFilter lFilter, Replace$(fltr.Criteria1, aOper(i), aOpp(i))
Exit For
End If
Next i
End If
End Sub
I'm working with an Excel report in which each month a new worksheet is added. Each row in the worksheet is for an employee, and the columns in that row is data related to them. Each week, the rows may vary, with names being added and removed.
I wrote the following VBA module to align the rows of 2 worksheets, adding blank rows as necessary, but I need to figure out a way to expand that so it aligns 12 worksheets, with multiple blank spaces between names as necessary. I'm not sure how to go about this, any suggestions?
Option Explicit
Sub Align()
Dim n As Long, a As Range, c As Range, x As Long
n = Cells.SpecialCells(11).Row
Set a = Worksheets("Jan").Range("A6:A200"): Set c = Worksheets("Feb").Range("A6:A200")
a(n + 1) = Chr(255): c(n + 1) = Chr(255)
a.Sort a(1), 1, Header:=xlNo
c.Sort c(1), 1, Header:=xlNo
Do
x = x + 1
If a(x) > c(x) Then
a(x).EntireRow.Insert xlShiftDown
ElseIf a(x) < c(x) Then
c(x).EntireRow.Insert xlShiftDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x) = Chr(255) And c(x) = Chr(255)
a(x).ClearContents: c(x).ClearContents
End Sub
I do not believe any simple rearrangement of your existing code will meet your needs. I also believe this is too big a question to expect anyone to create an entire macro for you.
Below I outline the approach I would take to solving your problem. I suggest you try to solve each issue in turn. None of the code I give has been tested so I doubt it is error-free. Debugging my code should help you understand it. If you run into difficulties, you can come back to me with questions. However, it would be better to attempt to construct a new question including the code you cannot get working. With a single issue question, I believe you will get help more quickly than waiting for me to log in.
I hope this helps.
Issue 1 - Identifying the 12 worksheets
If the workbook only contains the 12 worksheets "Jan", "Feb" ... "Dec", then it is easy: worksheets 1 to 12. It does not matter if they are in the wrong sequence.
If the workbook contains other worksheets that are the first few worksheets of the workbook then it will be almost as easy: N to N+11.
If the other worksheets and the month worksheets are muddled, you will have to access then using an approach like this:
Dim InxMonth As Long
Dim InxWsht As Long
Dim WshtMonthName() As Variant
WshtMonthName = Array("Jan", "Feb", ... "Dec)
For InxMonth = 0 to 11
InxWsht = WshtMonthName(InxMonth)
With Worksheets(InxWsht)
:::::::
End with
Next
It might be better to use this approach anyway in case a user adds a new worksheet. This technique will work regardless of what other worksheets may exist.
Issue 2 - Get sorted list of names
You need a list in alphabetic order containing every name that appears in any worksheet. I can think of a number of approaches. I was taught: get the code working then make it faster, smoother or whatever. I have picked an approach that I think is easy to implement. Other approaches would be faster to execute but it does not sound as though you will be executing the code very often and there are only 12 worksheets. Your taking hours to debug complex code that will shave a few seconds off the run time is not a good use of your time.
Issue 3 - Sort the worksheets
You have code to sort a single worksheet. You need to put that code in a loop which you execute for each of the month worksheets.
Issue 4 - Create list of names
This approach is not very elegant and I can think of much faster approaches. However I think it is easy to understand what this code is doing.
I have initialised NameList to 200 entries because your code seem to assume that there are fewer than 200 employees. However the code enlarges the array if necessary.
Dim InxNameCrntMax as Long
Dim InxMonth As Long
Dim InxWsht As Long
Dim NameList() As String
Dim NextLowestName As String
Dim RowCrnt As Long
Dim WshtRowCrnt() As Long
ReDim NameList(6 to 200) ' 6 is first data row
InxNameCrntMax = 0
ReDim WshtRowCrnt(0 To 11)
' For each worksheet set the current row to the first data row
For InxMonth = 0 to 11
WshtRowCrnt(InxMonth) = 6
Next
Do While True
' Loop until every name in every worksheet has been added to NameList
NextLowestName = "~" ' Greater than any real name
' Examine the next row in each worksheet and find the lowest name
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxMonth) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") <> "" Then
' Not all names from current worksheet added to NameList
If NextLowestName > .Cells(RowCrnt, "A") Then
' This name comes before previous next lowest name
NextLowestName = .Cells(RowCrnt, "A")
End If
End If
End With
Next
If NextLowestName = "~" Then
' All names from all worksheets added to NameList
Exit Do
End If
' Add NextLowestName to NameList
InxNameCrntMax = InxNameCrntMax + 1
If InxNameCrntMax > UBound(NameList) Then
' NameList is full so enlarge it
ReDim Preserve NameList(6 To UBound(NameList) + 100)
End If
NameList(InxNameCrntMax) = NextLowestName
' Step the current row for every worksheet containing NextLowestName
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxWsht) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") = NextLowestName Then
WshtRowCrnt(InxWsht) = RowCrnt + 1
End If
End With
Next
Loop
Issue 5 - Using NameList
I initialised the size of NameList to (6 To 200) although it may have been enlarged so it could now be (6 To 300) or (6 To 400).
VBA is one of the few languages that does not require the lower bound of an array to be 0. It is worth taking advantage of this feature. I understand from your code that 6 is the first data row of the worksheets. That is why I set the lowest bound to 6; it means the element numbers match the row numbers.
InxNameCrntMax is the last used entry in NameList so we have something like:
NameList(6) = "Aardvark, Mary"
NameList(7) = "Antelope, John"
NameList(8) = "Bison, Jessica"
::::::
NameList(InxNameCrntMax) = "Zebra, Andrew"
So if for Worksheets("Jan") there is no Mary Aardvark, row 6 should be empty. If there is a John Antelope, his data belongs on row 7.
In your code, you use InsertRow to insert blank lines. I do not really like updating worksheets in situ because, if you mess up, you have to reload the data from a backup copy.
I would rather build worksheet "JanNew" from Jan", "FebNew" from "Feb" and so on. When all these new worksheets had been created, I would rename "Jan" to "JanOld" and so on and then I would rename "JanNew" to "Jan" and so on. Only when I was absolutely convinced I had moved the data correctly would I delete the old worksheets.
However, I have to admit your approach is easier. I leave you to decide what to do.
I have a long excel list (+10k rows) and a column with ordernumbers.
Unfortunatelly some orders were deleted.
My question is simple but to achieve probabily not: I want to count the deleted rows, basically the missing ordernumbers.
A hint is aprechiated.
endo
I don't know how to do this using Excel code, but if you go to the bottom and get the last order number, you can calculate how many there should be with
last order number - first order number = expected amount
How many their actually are would be
last order index - first order index = actual amount
Then you can do
expected amount - actual amount = missing order numbers
Of course, this assumes there are no blank rows between order numbers, and that you only need to do this once. (you prob want a function or something to have it update as you change the spreadsheet)
This covers blank rows and numbers missing from the sequence (however, if your min/max are deleted, this can't detect that). It's similar to #shieldgenerator7's answer.
No sorting necessary for this.
EDIT: As sheildgenerator7 pointed out, this assumes that you expect all of your order numbers to be sequential.
=(MAX(A2:A26)-MIN(A2:A26)+1)-COUNTA(A2:A26)
You can now count blanks in Excel with a simple function called COUNTBLANK. If you know the ending row number (for example, if the data were in A1 to A10000), you can use this formula:
=COUNTBLANK(A1:A10000)
If the numbers are sequential it is pretty easy.
Sort by order number
Count in B4
=(A4-A3)-1
Sum in B17
=SUM(B3:B16)
Here's something I put together to identify missing numbers and optionally print the list out on a new workbook.
You can change the minimum and maximum number, and it does not matter if the list is sorted or not.
Sub FindMissingNumbers()
Dim lstRange As Range
Dim r As Long
Dim lowestNumber As Long
Dim highestNumber As Long
Dim missingNumbers() As Variant
Dim m As Long
Dim wbNew As Workbook
'## Set this value to the lowest expected value in ordernumber'
lowestNumber = 0
'## Set this value to your highest expected value in ordernumber'
highestNumber = 100
'Assuming the order# are in column A, modify as needed:'
Set lstRange = Range("A1", Range("A1048576").End(xlUp))
For r = lowestNumber To highestNumber
'## Check to see if this number exists in the lstRange
If IsError(Application.Match(r, lstRange, False)) Then
'## Add this number to an array variable:'
ReDim Preserve missingNumbers(m)
missingNumbers(m) = r
m = m + 1
End If
Next
If MsgBox("There were " & m & " missing order numbers" _
& vbNewLine & "Do you want to print these numbers?", vbYesNo) = vbYes Then
Set wbNew = Workbooks.Add
With wbNew.Sheets(1)
' For r = LBound(missingNumbers) To UBound(missingNumbers)
' .Range("A1").Offset(r, 0).Value = missingNumbers(r)
' Next
.Range("A1").Resize(UBound(missingNumbers) + 1) = _
Application.WorksheetFunction.Transpose(missingNumbers)
End With
Else:
End If
End Sub
I've pieced together a macro to allow me to calculate the cost of a story task by calculating the specific rate based on the developer assigned. I have the rate table on a second sheet. I am able to get a result for the cell that the macro is set to (Row 2), but want it to run on all rows. I know I have to set a generic range, but am not sure. How should I change the range declare to run on all rows?
Here is the code:
Sub GetCost()
Range("D2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Dim Estimate As Integer, Assignee As String, RodRate As Integer, GarthRate As Integer, DerekRate As Integer, TotalCost As Integer
Estimate = ThisWorkbook.Worksheets("Sheet1").Range("D2").Value
Assignee = ThisWorkbook.Worksheets("Sheet1").Range("E2").Value
RodRate = ThisWorkbook.Worksheets("Sheet2").Range("B2").Value
GarthRate = ThisWorkbook.Worksheets("Sheet2").Range("B3").Value
DerekRate = ThisWorkbook.Worksheets("Sheet2").Range("B4").Value
If Assignee = "Rod" Then
TotalCost = Estimate * RodRate
ElseIf Assignee = "Garth" Then
TotalCost = Estimate * GarthRate
ElseIf Assignee = "Derek" Then
TotalCost = Estimate * DerekRate
Else
TotalCost = "0"
End If
ThisWorkbook.Worksheets("Sheet1").Range("F2").Formula = TotalCost
ActiveCell.Offset(1, 0).Select
Loop
End Sub
I have rewritten your code with explanations which I hope are enough for you to understand why. There is much more that I could say. I hope this is a good balance between too little and too much.
However, I have to point out that there are some excellent project management tools available. I do not believe this is a good use of your time.
Random points
On 32-bit computers, Long is better than Integer.
Do not declare your variables inside a loop. The scope of a variable declared inside a sub-routine is the
the sub-routine so declare them at the top of the sub-routine.
You can declare all your variables in a single Dim statement but I find it confusing unless there is a real association between two or more variable. I might have:
Dim RodRate As Long, GarthRate As Long, DerekRate As Long
because these variables are associated. However the trouble with this approach is that you will have to add MaryRate and JohnRate and AngelaRate when these people join your project.
You need an array:
Dim PersonRate(1 To 3) As Long
where PersonRate(1) = Rate for Rod, PersonRate(2) = Rate for Garth and PersonRate(3) = Rate for Derek.
But this is hardly any better. You want a table that can grow. So today:
Name Rate
Rod 20
Garth 25
Derek 15
Next week:
Name Rate
Rod 20
Garth 25
Derek 15
Mary 30
With this, you pick up the Assignee's name, run down the table until you find their name then look across for their rate.
I assume you have a table like this in Sheet2. You could keep going back to Sheet2 but better to load the table into an array.
We could have:
Dim PersonName() As String
Dim PersonRate() As Long
so PersonRate(2) gives the rate for PersonName(2).
Note in my first array declaration I wrote: PersonRate(1 To 3). This time, the brackets are empty. With PersonRate(1 To 3), I am saying I want exactly three entries in the array and this cannot be changed. With PersonRate(), I am saying I want an array but I will not know how many entries until run time.
I said we could have two arrays, PersonName() and PersonRate() and this is what I have done. This is an easy-to-understand approach but I do not think it is the best approach. I prefer structures. When you have got this macro working and before you start your next look up User Types which is the VBA name for a structure.
Consider:
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
End With
There is a lot to explain here.
Cells means I want to address a cell within the active workbook. .Cells means I want to address a cell within the sheet identified in the With statement. This means I do not have to select Sheet1 or Sheet2 to look at their contents. Selecting worksheets is slow and the code tends to be more difficult to understand.
.Cells(Row, Column) identifies a cell. Row must be a number but column can be a number or a column code: A=1, B=2, Z=26, AA=27, etc.
Rows.Count returns the number of rows in a sheet for the version of Excel you are using. So .Cells(Rows.Count, "A") identifies the bottom of column "A".
End(xlUp) is the VBA equivalent of clicking Ctrl+UpArrow. If you are not familar with Ctrl+Arrow I suggest you play with these four controls. Note, these controls give easy to understand results with a rectangular table. However, if there are empty cells, the results can be strange.
Putting this together: .Cells(Rows.Count, "A").End(xlUp).Row means start at the bottom of column A, go up until you hit a cell with a value and return its row number. So this sets RowMax to the last row of the Rate table. When you add row 5 with Mary's name and rate, this code will automatically adjust.
Revised code
This should be enough to get you started. Welcome to the joys of programming.
' * Require all variables to be declared which means a misspelt name
' is not taken as an implicit declaration
Option Explicit
Sub GetCost()
Dim Estimate As Integer
Dim Assignee As String
Dim TotalCost As Integer
Dim PersonName() As String
Dim PersonRate() As String
Dim InxPerson As Long
Dim RowCrnt As Long
Dim RowMax As Long
' You can declare constants and use them in place of literals.
' You will see why later. I could have made these strings and
' used "A", "B", "D", "E" and "F" as the values. Change if that
' is easier for you.
Const ColS2Name As Long = 1
Const ColS2Rate As Long = 2
Const ColS1Estimate As Long = 4
Const ColS1Assignee As Long = 5
Const ColS1Total As Long = 6
' Before doing anything else we must load PersonName and PersonRate from
' Sheet2. I assume the structure of Sheet2 is:
' A B
' 1 Name Rate
' 2 Rod 20
' 3 Garth 25
' 4 Derek 15
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, ColS2Name).End(xlUp).Row
' I now know how big I want the the name and rate arrays to be
ReDim PersonName(1 To RowMax - 1)
ReDim PersonRate(1 To RowMax - 1)
' Load these arrays
For RowCrnt = 2 To RowMax
' I could have used 1 and 2 or "A" and "B" for the column
' but this is easier to understand particularly if you come
' back to this macro in six month's time.
PersonName(RowCrnt - 1) = .Cells(RowCrnt, ColS2Name).Value
PersonRate(RowCrnt - 1) = .Cells(RowCrnt, ColS2Rate).Value
Next
End With
With Sheets("Sheet1")
' I am using the same variable for rows in sheets Sheet1 and Sheet2.
' This is OK because I never look at Sheet1 and Sheet2 at the same time.
RowCrnt = 2
Do Until IsEmpty(.Cells(RowCrnt, ColS1Estimate))
Estimate = .Cells(RowCrnt, ColS1Estimate).Value
Assignee = .Cells(RowCrnt, ColS1Assignee).Value
.Cells(RowCrnt, ColS1Total).Value = 0
' Locate the Assignee in the PersonName array and
' extract the matching rate
For InxPerson = 1 To UBound(PersonName)
If PersonName(InxPerson) = Assignee Then
.Cells(RowCrnt, ColS1Total).Value = Estimate * PersonRate(InxPerson)
Exit For
End If
Next
RowCrnt = RowCrnt + 1
Loop
End With
End Sub
Tony's answer is a great solution and introduction to programming and very well written so I've +1 it. However unless I'm missing something code should always be the last resort in excel as it is very slow compared to formulas, I would have thought that a simple lookup would suffice, something like:
=D2*(vlookup(E2,'sheet2'!A:B,2,FALSE))
Copied down the column