I am in the process of simplifying a series of statements which are unnecessarily complex. I wish to simplify the below example using a For i procedure, but I am unsure how to increase the scope of my statement to affect the visibility of more objects on the sheet (this may be an easy solve that I am missing somehow, tunnel vision may be in effect today).
Example:
Sheet1 contains 135 chart objects, which are labeled in the following pattern:
A1Z
A2Z
A3Z
A4Z
A5Z
A6Z
A7Z
A8Z
A9Z
B1Z
B2Z
B3Z
B4Z
B5Z
B6Z
B7Z
B8Z
B9Z
And so on, through to the final object on the sheet, "O9Z".
Currently a CommandButton_Click event is assigned button on the sheet that calls these (ugly) procedures, which are written as follows:
If Sheet2.Range("D12").Value = "A1Z" Then
Sheets("Charts").ChartObjects("A1Z").Visible = True
Sheets("Charts").ChartObjects("A2Z").Visible = False
Sheets("Charts").ChartObjects("A3Z").Visible = False
Sheets("Charts").ChartObjects("A4Z").Visible = False
Sheets("Charts").ChartObjects("A5Z").Visible = False
Sheets("Charts").ChartObjects("A6Z").Visible = False
Sheets("Charts").ChartObjects("A7Z").Visible = False
Sheets("Charts").ChartObjects("A8Z").Visible = False
Sheets("Charts").ChartObjects("A9Z").Visible = False
Sheets("Charts").ChartObjects("B1Z").Visible = False
Sheets("Charts").ChartObjects("B2Z").Visible = False
Sheets("Charts").ChartObjects("B3Z").Visible = False
Sheets("Charts").ChartObjects("B4Z").Visible = False
Sheets("Charts").ChartObjects("B5Z").Visible = False
Sheets("Charts").ChartObjects("B6Z").Visible = False
Sheets("Charts").ChartObjects("B7Z").Visible = False
Sheets("Charts").ChartObjects("B8Z").Visible = False
Sheets("Charts").ChartObjects("B9Z").Visible = False
I am able to simplify this bloated procedure somewhat using a For i statement:
If Sheet2.Range("D12").Value = "A1Z" Then
Dim i As Integer
For i = 2 To 9
Sheets("Charts").ChartObjects("A" & i & "Z").Visible = False
Sheets("Charts").ChartObjects("A1Z").Visible = True
Next i
One problem with my procedure however is that it will only affect the visibility of objects A2Z through A9Z without affecting objects B1Z-O9Z.
I believe it may be possible to add a second variable in addition to i that loops through each letter in a range "A", "B", "C", "D" and so on to letter "O" and adjust the For i statement to account for it, so that every object on the worksheet that does not match the value in quotes in the If statement (in this example, "A1Z") is hidden.
I am unsure of which method to employ to account for that range of letters however.
Try looping through all the chart objects.
Dim cht As ChartObject
For Each cht In Sheets("Chart").ChartObjects
cht.Visible = cht.Name = "A1Z"
Next cht
If you want the chart that is visible to be dynamic then:
Dim cht As ChartObject
For Each cht In Sheets("Chart").ChartObjects
cht.Visible = cht.Name = Sheet2.Range("D12").Value
Next cht
You could try something like this using a for each loop:
Dim chartObj As ChartObject, strTest As String
strTest = Sheet2.Range("D12").Value
For Each chartObj In Sheets("Charts").ChartObjects
If chartObj.Name = strTest Then
chartObj.Visible = True
Else
chartObj.Visible = False
End If
Next chartObj
A for each loop enables you to iterate through each object in a collection, for example you could do it for each worksheet in sheets
Related
So my problem is that I have a sheet in which a multitude of grouped rows exist. The rows are grouped in 2 levels. To put this in perspective, I have a group which covers the rows in A1:A55. Inside this first level group I have multiple second level groups covering smaller sections (e.g. rows in A2:A5, rows in A7:A10 and so on.). Because of Excel automatically adding groups together if they are adjacent to each other, I have added a blank row in between each 2nd level group of rows(A6, A11, etc.). I then proceeded to change the height of these blank rows to 0,00. This hid the + and - signs on the left hand bar for collapsing/expanding, which wasn't a problem as the collapsing and expanding is being handled via buttons on the sheet.
However, when all the grouped rows, or just the 2nd level grouped rows, are being expanded (either manually or via a macro), the row height of all the blank rows jumps back to a size at which Excel can display the + and - signs in the left hand bar again. This shows the blank rows which I want to prevent.
I know I probably can't prevent the resizing of the rows so it displays the + and - signs, however I was thinking about immediately resizing the blank rows to a height of 0.00. This is being built in the macro that is called via the buttons, but the concern is when a user expands the rows manually. There is no event for collapsing and or expanding for me to use in an event handler. Is there any way for me to have an automatic response on a manual expand action by the user?
I have provided a example of the code used below.
Sub Select1Year_Click()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Overview")
Dim ws2 As Worksheet
Set ws2 = Worksheets("Selection Tab")
Dim ROffset As Integer
ROffset = ((ws2.Range("B33").Value - 1) * 4) 'User defined starting Year
'value
On Error Resume Next
With ws1
.Range("AJ2").Rows.ShowDetail = False '2018
.Range("AJ7").Rows.ShowDetail = False '2019
.Range("AJ12").Rows.ShowDetail = False '2020
.Range("AJ17").Rows.ShowDetail = False '2021
.Range("AJ22").Rows.ShowDetail = False '2022
.Range("AJ27").Rows.ShowDetail = False '2023
.Range("AJ32").Rows.ShowDetail = False '2024
.Range("AJ37").Rows.ShowDetail = False '2025
.Range("AJ42").Rows.ShowDetail = False '2026
.Range("AJ47").Rows.ShowDetail = False '2027
.Range("AJ52").Rows.ShowDetail = False '2028
End With
If ws2.Range("B31").Value = 1 Then 'User selected 1 year to be shown in
'expanded view
ws1.Range("AJ2").Offset(0, ROffset).Rows.ShowDetail = True
End If
End Sub
'------------------------------------------------------------------------
Sub Select10Year_Click()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Overview")
Dim ws2 As Worksheet
Set ws2 = Worksheets("Selection Tab")
Dim i As Integer
Dim ROffset As Integer
ROffset = ((ws2.Range("B33").Value - 1) * 4) 'User defined starting Year
'value
If ws2.Range("B31").Value = 3 Then 'User selected all years to be expanded
On Error Resume Next
ws1.Shapes("Select10Year").ControlFormat.Value = True
With ws1
.Range("AJ2").Rows.ShowDetail = True '2018
.Range("AJ7").Rows.ShowDetail = True '2019
.Range("AJ12").Rows.ShowDetail = True '2020
.Range("AJ27").Rows.ShowDetail = True '2021
.Range("AJ22").Rows.ShowDetail = True '2022
.Range("AJ27").Rows.ShowDetail = True '2023
.Range("AJ32").Rows.ShowDetail = True '2024
.Range("AJ37").Rows.ShowDetail = True '2025
.Range("AJ42").Rows.ShowDetail = True '2026
.Range("AJ47").Rows.ShowDetail = True '2027
.Range("AJ52").Rows.ShowDetail = True '2028
End With
If ROffset > 0 Then 'User has selected a different starting year then
'2018, so collapse are years before selected
'starting year
For i = 0 To i = ROffset Step 1
ws1.Range("AJ2").Offset(0, ROffset).Rows.ShowDetail = False
Next i
End If
End If
End Sub
Any help would be greatly appreciated.
You can have your macro being launched as a result of a Worksheet_Change() event.
I am working on my VBA code for a PivotTable field.
What I want to achieve is to only select Acc Payable in field Group. The following code can help me get what I want, but I'm considering whether there is a way to delete those False lines and make the code shorter?
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Group")
.PivotItems("Acc Services").Visible = False
.PivotItems("FRG").Visible = False
.PivotItems("Non FinOps").Visible = False
.PivotItems("Semi Auto").Visible = False
.PivotItems("Acc Payable").Visible = True
End With
End With
You can use a For loop, to iterate through the PivotField named "Group" PivotItems, and if the PivotItem.Name = "Acc Payable" then make it visible.
Code
Dim PvtItm As PivotItem
For Each PvtItm In ActiveSheet.PivotTables("PivotTable1").PivotFields("Group").PivotItems
If PvtItm.Name = "Acc Payable" Then
PvtItm.Visible = True
Else
PvtItm.Visible = False
End If
Next PvtItm
Currently working on a vba script that makes charts automatically. I would like to add a datatable which is done using: .HasDataTable = True
However I would like to show the values of series as percentages. Currently the value is defined as a Double containing all the values but not the right formatting. Using Format() or FormatPercent() will give the right values but returned in a String. This works for the datatable but not for the chart itself since it doesn't recognize the values anymore.
My question comes down to whether it is possible to show the values as percentages in both the datatable and the chart? Without VBA it is easily done by formatting the data in the cells itself. The problem is that for formatting a String is returned but for the graph Integers or Doubles are needed.
Below is part of the code. If I dim Ratio as String and use FormatPercent() I get the requested formatting but then the values in Ratio ar no longer doubles so it doesn't give the required chart.
Dim Ratio() As Double
Dim labels() As String
ReDim Ratio(1 To Height)
ReDim labels(1 To Height)
For Each Column In sArray
labels(i) = Sheets(DataSheetName).Cells(LabelsRow, Column)
Ratio(i) = Math.Round(Sheets(DataSheetName).Cells(LabelsRow + 3, Column), 2)
i = i + 1
Next Column
Set myChtObj = Sheets(DrawSheetName).ChartObjects.Add(Left:=Left, Width:=Width, Top:=Top, Height:=HeightGraph)
Dim srsNew1 As Series
' Add the chart
With myChtObj.Chart
.ChartArea.Fill.Visible = False
.ChartArea.Border.LineStyle = xlNone
.PlotArea.Format.Fill.Solid
.PlotArea.Format.Fill.Transparency = 1
.HasTitle = True
.ChartTitle.text = Title
.HasLegend = False
.Axes(xlValue).TickLabels.NumberFormat = "0%"
.Axes(xlCategory, xlPrimary).HasTitle = False
'add data table
.HasDataTable = True
' Make Line chart
.ChartType = xlLine
' Add series
Set srsNew1 = .SeriesCollection.NewSeries
With srsNew1
.Values = Ratio
.XValues = labels
.Name = "Ratio"
.Interior.Color = clr3 'RGB(194, 84, 57)
End With
End With
I'm trying to create a log in with multiple users. I have a welcome sheet with cells specifically for the username and password and a sheet with the username and password combinations.
I'm getting an error at If wk.Range("B3").Value = ws.Range(i, "A").Value Then
it says "object defined" error.
I thought it made sense to just try to check if the string in the cell matched a username/password in the users sheet through a loop.
I'm not sure if I'm going about it right. And then depending on if you log in as an operator or another user it affects which sheets you see.
Public CurrentUser As String, CurrentRole As String, LoginUserName As String, LoginPassword As String
Public LoginStatus As Boolean
Sub Login()
'Worksheets("Users").Activate
Dim numberOfUsers, i As Integer
Dim ws, wk As Worksheet
Set ws = ThisWorkbook.Worksheets("Users")
Set wk = ThisWorkbook.Worksheets("Welcome")
numberOfUsers = ws.Range("Users").Rows.Count
LoginStatus = False
For i = 1 To numberOfUsers
If wk.Range("B3").Value = ws.Range(i, "A").Value Then
If wk.Range("B4").Value = ws.Range(i, "B").Value Then
CurrentUser = wk.Range("B3").Value
LoginStatus = True
Else
LoginStatus = False
MsgBox ("Wrong Login Data")
End If
Else
LoginStatus = False
MsgBox ("Wrong Login Data")
Next i`
Select Case CurrentUser
Case "Operator"
Worksheets("Received_Calls").Visible = True
Worksheets("Welcome").Visible = False
Worksheets("Users").Visible = False
Worksheets("Reported_actions").Visible = False
Worksheets("Parameters").Visible = False
Worksheets("Distances").Visible = False
Worksheets("NewCalls").Visible = False
Worksheets("NewActions").Visible = False
Case Else
Worksheets("Received_Calls").Visible = False
Worksheets("Welcome").Visible = False
Worksheets("Users").Visible = False
Worksheets("Reported_actions").Visible = True
Worksheets("Parameters").Visible = False
Worksheets("Distances").Visible = False
Worksheets("NewCalls").Visible = False
Worksheets("NewActions").Visible = False
'need to filter
End Select
End Sub
I cant comment yet (less than 50 rep), so I'll put this in an answer, but I'd like to address a commenter above:
sous2817 - both wk and ws are dimensioned as worksheets, so the comparison is correct.
Now to the Answer:
As Dirk states, the workbook.Range() function takes two arguments, but they should both be cell addresses in string format, and if both are supplied, the range returned will include all cells between them. You have:
ws.Range(i, "A").Value
which is telling excel to get cell i and cell "A" and get all cells in a square between them. This won't work because there is no such cell as "A" (and you would refer to column A as "A:A"), and the variable i will evaluate to a number (again there is no such address as 1,2,3, etc, only "1:1" etc)
What you need to change this to is, as Dirk says:
ws.Range("A" & i).value
The ampersand (&) acts as a concatenator, and will create a string for each iteration of the loop, evaluating into A1, A2, A3 etc.
You will need to do the same for the Range function that references column B as well.
Having said all that, a better solution would the answer eluded to by sous2817 in their second comment in that you could do this:
Dim userCell as Range
Set userCell = ws.Range("Users").Resize(,1).Find(wk.Range("B3").Value)
If userCell is nothing then
'Username is invalid code goes here
Elseif wk.Range("B4").Value = userCell.offset(,1).value then
'Password is valid
Else
'Password is invalid
End If
As findwindow stated, you can expand upon this by first checking if the username supplied matches Application.UserName to see if it is the current windows user.
Hope this helps!
I have an Excel VBA UserForm Combobox for scanning asset tags to compare against a site baseline held in Sheet1. There can be upto 50,000+ assets. The named ranges are all correct.
I want the loop to fill the "Found" Asset attribute Textboxes for Type, Serial, MakeModel, Location & PrinterHost.
The code is below without the additional index match lookups for extra asset attributes as the process will be the same. Help appreciated as I'm not sure where I'm going wrong. Thanks in advance.
Private Sub ComboScanTag_Change()
Dim x As Integer
Dim AssetCount As Long
Dim BASELINE As Range
Dim AssetID As Range
Dim FoundType As Variant
Dim FoundSerial As Variant
Dim FoundMakeModel As Variant
Dim FoundLocation As Variant
Dim FoundPrinterHostName As Variant
If Me.ComboScanTag.Value = "" Then 'ScanTag has no value
MsgBox "Asset not Found - Re-Scan or enter New Asset details"
Me.ComboScanTag.SetFocus
End If
If Me.ComboScanTag.Value <> "" Then 'ScanTag has a value
Application.ScreenUpdating = False 'Turn off screen updating to speed app
For x = 1 To AssetCount 'Number of loop iterations from Baseline Assets Count D1 cell
FoundType = Application.Index("BASELINE", Application.Match(Me.ComboScanTag.Value, "AssetID", False), 3)
If Not IsError(FoundType) = False Then 'if error value in lookup return 0
Me.txtFoundType.Value = FoundType 'Fill textbox FoundType with lookup value from baseline
Else
On Error GoTo 0 'reset error handler
FoundSerial = Application.Index("BASELINE", Application.Match(Me.ComboScanTag.Value, "AssetID", False), 11)
If Not IsError(FoundSerial) = False Then
Me.txtFoundSerial.Value = FoundSerial
End If
Next x
End If
Application.ScreenUpdating = True
End Sub
AssetCount is not initialized. You need to initialize it before you use it like AssetCount = 10.
BASELINE and AssetID are not set as well.
If BASELINE and AssetID are named ranges, you cannot use it the way you do in Application.Index or Application.Match.
You need to pass it as object and not as string like this:
Set BASELINE = ThisWorkbook.Names("BASELINE").RefersToRange
Set AssetID = ThisWorkbook.Names("AssetID").RefersToRange
Then you can use it like this in Application.Index and Match:
With Application
FoundType = .Index(BASELINE, .Match(Me.ComboScanTag.Value, AssetID, False), 3)
End With