I want to mark a graph based on filtered datas. Unfortunately my code is using ALL datas instead of the filtered data, sothat the mapping wrong.
For the marking I want to use the first letter of the second and third column. The data starts at row number three. Can you tell me a solution to use only the visible data?
Sub BeschriftungDiagramm()
Dim lngPunkt As Long
Dim data As Worksheet
Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
.ApplyDataLabels
For lngPunkt = 1 To .Points.Count
.Points(lngPunkt).DataLabel.Text = Left(data.Cells(lngPunkt + 2, _
2), 1) & " " & Mid(data.Cells(lngPunkt + 2, 3), 2, 1)
Next lngPunkt
End With
End Sub
I hope you got enough information to understand my problem. Thank you in advance :)
Related
Each configuration is set-up as a different Part number that makes up one complete device. We want to find out how many of each full configuration we have sold to tell the highest selling combinations. The configuration numbers relate to an option of the product for instance 12345-W means wireless.
We need to find out how many of each string of configurations we have to count them. This has a few columns that will help to find the configuration. You can look at the line number and the sales number to ensure that they are in the same grouping on the sales order. For instance one whole config that makes up a finished product will have line number 1 for all parts associated with the finished product, going down the sales order numerically. We can use this in combination with the sales order to come up with the Configuration String. Then we can look at the config column and part column to differentiate the base config from the options. The "C" in the Config column tells us it's the base model, the "X" tells us it's an option.
With this information we need to create the configuration string shown as a manual example in blueish/purple column, photo linked below. Once we have the string it's just counting the "C" config option only to avoid double counting then we can make a Pivot Table to tell how many duplicates of the same option there are and filter for C only. These are multiple different products, and multiple different configurations of different products.
Here is the Set-up:
Data example: the Blue column is an example manually of what is needed
Some thoughts I had were an If, then statement, Concatenation IF, or a Macro. But nothing has worked out so far. Any advice would be greatly appreciated!
To be able to do that efficient you need to ensure that the data is sorted in the following way:
by Sales
by linenum
by Config
by Part
It needs to be sorted by all 4 columns at once and in this order or you might end up with messed up data!
It is also assumed that the option numbers are always prefixed with the corresponding base number plus a dash.
Then we read the columns we need into arrays (for faster processing). We loop through that data line by line. When we find a C in config we rember that row number (for comparison of the X options and for writing the output). We move on with the next row and check if it is an option and if it belongs to the rembered base config. If so we append the option part no to the base config.
In the end we write the array data back to the cells.
Option Explicit
Public Sub GetFullConfigFromOptions()
Dim ws As Worksheet ' define your sheet here
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' read data columns into array
Dim ArrSalesNo() As Variant 'define Sales column
ArrSalesNo = ws.Range("A1").Resize(RowSize:=LastRow).Value
Dim ArrConfig() As Variant 'define Config column
ArrConfig = ws.Range("B1").Resize(RowSize:=LastRow).Value
Dim ArrPartNo() As Variant 'define Part column
ArrPartNo = ws.Range("C1").Resize(RowSize:=LastRow).Value
Dim ArrLineNo() As Variant 'define Linenum column
ArrLineNo = ws.Range("E1").Resize(RowSize:=LastRow).Value
' create output array
Dim ArrOut() As Variant 'define String column
ArrOut = ws.Range("D1").Resize(RowSize:=LastRow).Value
Dim CurrentConfigRow As Long
Dim iRow As Long
For iRow = 2 To LastRow
If ArrConfig(iRow, 1) = "C" Then
' is config line …
CurrentConfigRow = iRow ' remember line number for output
If iRow = LastRow Then
' base without options (in last row)
ArrOut(CurrentConfigRow, 1) = ArrPartNo(CurrentConfigRow, 1) ' write base part number to output (without dash)
ElseIf Not ArrSalesNo(CurrentConfigRow + 1, 1) = ArrSalesNo(CurrentConfigRow, 1) Or _
Not ArrLineNo(CurrentConfigRow + 1, 1) = ArrLineNo(CurrentConfigRow, 1) Or _
Not ArrConfig(CurrentConfigRow + 1, 1) = "X" Then
' base without options
ArrOut(CurrentConfigRow, 1) = ArrPartNo(CurrentConfigRow, 1) ' write base part number to output (without dash)
Else
' base with options
ArrOut(CurrentConfigRow, 1) = ArrPartNo(CurrentConfigRow, 1) & "-" ' write base part number to output (including dash)
End If
Else
' check if it is an option line of the remebered config line
If ArrSalesNo(iRow, 1) = ArrSalesNo(CurrentConfigRow, 1) And _
ArrLineNo(iRow, 1) = ArrLineNo(CurrentConfigRow, 1) And _
ArrConfig(iRow, 1) = "X" Then
' is option line (so append to output)
ArrOut(CurrentConfigRow, 1) = ArrOut(CurrentConfigRow, 1) & Mid$(ArrPartNo(iRow, 1), Len(ArrPartNo(CurrentConfigRow, 1)) + 2)
End If
End If
Next iRow
' write ouput to cells
ws.Range("D1").Resize(RowSize:=LastRow).Value = ArrOut
End Sub
The output will look like
I need help. Is it possible to import a data from one sheet to another but the data I'm trying to import should be substracted from a tab of the original sheet?
The formula should look like this:
=(importrange("https://LINKHERE","JAN!j18")).
Now the data on J18 is what I'm trying to import but it is being added from Jan!j18. I'm trying to put this to Feb!j18 (but wants to exclude the added data from Jan!18. It was added intentionally to feb but the other sheet needs a monthly numbers only. Any help please?
Sorry, I don't quite follow your problem.
But if you import a range into an array, you can then loop through it and manipulate it
Sub test1()
arr1 = Range(Worksheets(1).Cells(1, 1), Worksheets(1).Cells(4, 3))
'Note, that the array will start at 1, rather than 0.
For iRow = 1 To UBound(arr1, 1)
For iCol = 1 To UBound(arr1, 2)
'Which is convenient as we're pasting back to a workbook
Worksheets(2).Cells(iRow, iCol) = arr1(iRow, iCol) + 10
Next iCol
Next iRow
End Sub
Do pay attention to the array indices - as going to and from ranges & workbooks is abnormal relative to usual array use
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
I am trying to make a sum formula on a dynamic range. Much like in a pivot table.
Taking a look on the picture I want L15 to be the sum of the range from L16 to the blank row. As the range is dynamic I am not sure how to write it on my code. So far what I have is this:
If out.Range("A15").Cells(i, 1) = "Aktier" Then
out.Range("L15").Cells(i, 1) = Application.WorksheetFunction.Sum(Range("L15").Cells(i + 1, 1), Range("L15").Cells(i + 1, 1).End(xlDown))
End If
So my question is basically how do I write something like Sum(A1:End(xlDown))? :)
Hope you can help me out guys! :D
Thanks in advance!
First I would recommend that every time that's possible, you get a structure more Data Base-like, so I would have a column repeating the concept and then you could use the Excel SUMIF function easily.
Probably that's not your case (that seems the output of an accounting program). Taking advantage of using VBA macros, you can use a loop to generate the column I mentioned before (you could do the sum as well using the concept, but I believe is cleaner generating a better data format). Please see the image below:
Sub Add_Concepts()
i = 1
Concept = Cells(i, 2)
i = 2
Do While (Cells(i, 2) <> "")
Cells(i, 1) = Concept
If Cells(i + 1, 2) = "" Then 'Change in concept
Concept = Cells(i + 2, 2) 'New concept
i = i + 2 'add 2 to skip the New concept line and the white space
End If
i = i + 1
Loop
End Sub
Now you can use the regular Excel functions.
Hope this helps!
Skipping Steps
Snippet:
If out.Range("A15").Cells(i, 1) = "Aktier" Then
With out.Range("L15")
.Cells(i, 1) = Application.WorksheetFunction _
.Sum(.Parent.Range(.Offset(1), .Offset(1).End(xlDown)))
End With
End If
Working example:
Option Explicit
Sub SumToBlank()
Dim out As Worksheet: Set out = ThisWorkbook.Worksheets("Sheet1")
Dim i As Long: i = 1
If out.Range("A15").Cells(i, 1) = "Aktier" Then
With out.Range("L15")
.Cells(i, 1) = Application.WorksheetFunction _
.Sum(.Parent.Range(.Offset(1), .Offset.End(xlDown)))
End With
End If
End Sub
Column 'P' ("P6:P3000") holds a value as such "EMPLOYEE_CONTRACT_STATUS_Closed". I am trying to pull the "Closed" (could also be "Open") portion out of the cell into column 'Q' or just replace the existing column 'P' value with the last text after the delimiter ("_")... "EMPLOYEE_CONTRACT_STATUS_Closed" --> "Closed" or "Open." This creates these steps:
Create new column Q
Insert new value in column header
Perform function in 'P' to either replace values or dump into column 'Q' ("Q6:Q3000")
Below I have what I have so far --> Code to create column and to call a function code to pull the last text after last delimiter... this is a part of an automated process so the goal is not to touch or manipulate any of the
cell values. I know there is possibly for a Subprocess to perform this but I cannot figure it out and keep scratching my head. This is my first time on the forum and for someone to supply a fixed code but also EXPLAIN the syntax behind it would be great because I am pretty experience with VBA, but have never ran into this process. THANKS ^_^
& 2. Creating new column and changing the header name:
Sub ContractStatus_Change()
Application.ScreenUpdating = False
Workbooks("DIV_EIB_Tool.xlsm").Worksheets("EIBMaintainEmployeeContractsW31").Range("Q5") _
.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("EIBMaintainEmployeeContractsW31").Range("Q5").Value = "Contract Status"
Worksheets("EIBMaintainEmployeeContractsW31").Range("Q6:Q3000").NumberFormat = "General"
Application.ScreenUpdating = True
End Sub
My function to pull last text out from disclosed value:
Function RightWord(r As Range) As Variant
Dim s As String
s = Trim(r.Value)
RightWord = Mid(s, InStrRev(s, "_") + 1)
End Function
I have not run into an error yet, just do not know how to piece this together, under assumption I can probably run this all through one sub process but I am having a massive brain fart.
Try this code
Sub Test()
Dim a, i&
With Worksheets("EIBMaintainEmployeeContractsW31")
.Columns("Q").Insert
a = .Range("P6:P" & .Cells(Rows.Count, "P").End(xlUp).Row).Resize(, 2).Value
For i = LBound(a) To UBound(a)
If InStr(a(i, 1), "_") Then
a(i, 2) = Split(a(i, 1), "_")(UBound(Split(a(i, 1), "_")))
End If
Next i
With .Range("Q5")
.Value = "Contract Status"
.Offset(1, -1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
End With
End Sub
I started the code by dealing with the sheet EIBMaintainEmployeeContractsW31 so between With and End With you will notice some lines start with dot which refers to this worksheet. Then insert a column before column Q and stored the required range which is P6 to P & last row into an array (arrays are faster)
After that looping the array which holds two columns (one for the raw data and the other for the required output). Make sure of underscore existence using InSstr function then if it exists store into the second column the last part of the split output based on the underscore.
Finally populating the array into the worksheet.
Hope that explanation helps you.