I've got the below code that works well, however I have soo many sub accounts(like "Ads_20_21") that I have to replicate the code many times over and create new named ranges to what is essentially just hiding/unhiding 3 rows below for every sub account. Is there a code that I can assign to a button that will just hide/unhide 3 rows below the active cell, I've tried looking everywhere for help but no luck. Much appreciated for any help.
Sub ToggleHiddenRow(rng As Range)
With rng.EntireRow
.Hidden = Not .Hidden
End With
End Sub
Sub Ads_20_21()
ToggleHiddenRow ActiveSheet.Range("Advertising_20_21")
End Sub
I suggest this code:-
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const TriggerClm As String = "A" ' change to suit
Const FirstDataRow As Long = 2 ' change to suit
Const RowsToHide As Long = 3 ' change to suit
Dim Rng As Range
Set Rng = Range(Cells(FirstDataRow, TriggerClm), Cells(Rows.Count, TriggerClm).End(xlUp))
If Not Application.Intersect(Target, Rng) Is Nothing Then
Set Rng = Range(Rows(Target.Row + 1), Rows(Target.Row + RowsToHide + 1))
Rng.Rows.Hidden = Not Rng.Rows(1).Hidden
Cancel = True
End If
End Sub
It's an event procedure that responds to the double-click event, meaning it runs when you double-click a cell. The event will be taken note of only in the code module of the sheet on which you want the action. Therefore it's essential that the procedure is installed in that module and nowhere else. Because of the special connection this module has to what's happening on the worksheet Excel sets up this module when a tab is created. Use the existing module, not one that you insert yourself.
The 3 constants at the top of the code are for you to adjust. Determine the column you want to double-click, the first data row and the number of rows you want to hide/show, starting from the row below the row you double-clicked. The procedure will not run when you double-click another column or above the first data row. When it runs, it will hide the 3 rows if they are visible or unhide them if they are hidden.
I would look for a way for the program to know when a row is clicked that pertains to a subaccount and skip the action for such rows. If you have such a criterium, establish it in code before If Not Application.Intersect(Target, Rng) Is Nothing Then and then include it in that same line. However, as the code is now, there won't be any big punishment for clicking the wrong row. Undoing the action just takes one double-click.
Related
SETUP:
Start with a sheet that has 3 columns. "ID", "MyNote", "MyDate" headers. This sheet may have thousands of rows of data.
I need to "flag" any row where the user has made a change to anything on the row. In other code the flagged rows will be in turn be used to update a table on my SQL server.
Typically there will only be a few rows the user would change/update in a session. So I don't want to process every row in the sheet, particularly the ones with no changes.
WHAT I HAVE WORKING NOW:
I have done this successfully by writing a "x" to an additional "flag" column any time the user makes a change. Then later I can process any rows that were flagged with a "x" . I did this using:
Private Sub Worksheet_Change(ByVal Target As Range)
...
' Flag any lines with a change
If Not Intersect(Target, Me.Range(TestForChangeColRange)) Is Nothing Then
Application.EnableEvents = False
' Set the "Pending Write" Flag
Target.Worksheet.Range(PendingWriteCol & Target.Row).Value = "x"
Application.EnableEvents = True
...
PROBLEM:
That works great for individual cells being updated one at a time. The problem comes when a user either a) uses the drag and copy (drag the bottom right corner of a cell to replicate it where dragged), or b) with a paste from some other workbook, in either case more than one cell is changed at a time.
In those cases, the Worksheet_Change sees only the first cell and not any extra cells edited by dragging or pasting.
I tried to find other similar solutions for intercepting Copy/Paste, etc., but I can't see anyway to find that if a copy was made, which cells were affected.
NEED:
All I need to know is which row numbers were affected from a drag or a copy/paste. If I can accurately flag those rows as updated, I'm in business.
FOLLOW-UP
Using Tim's solution. Having trouble melding something back into it.
Additionally I need to be able to check if a particular column was edited and if it was, clear a different column. For example, if Col 2 is edited, clear the contents of Col 3.
I tried adding the test inside the For loop, but my colno for rw.Col is coming out off.
If Not rng Is Nothing Then
'expand the range so we can flag by row, and not cell-by-cell
Set rng = Application.Intersect(rng.EntireRow, rngTbl)
For Each rw In rng.Rows 'loop over affected rows
Me.Cells(rw.Row, PendingWriteCol).Value = "x"
If rw.Column = RequestTypeCol Then
Me.Cells(rw.Row, LastColToClear).ClearContents
End If
Next rw
End If
Can you show me what I've done wrong?
For example (following on from Scott's comment):
Private Sub Worksheet_Change(ByVal Target As Range)
Const PendingWriteCol As Long = 4
Const TestForChangeColRange = "A:C"
Dim rw As Range, rng As Range, rngTbl As Range
Set rngTbl = Me.Range(TestForChangeColRange)
Set rng = Application.Intersect(Target, rngTbl) 'any monitored cells affected?
If Not rng Is Nothing Then
'expand the range so we can flag by row, and not cell-by-cell
Set rng = Application.Intersect(rng.EntireRow, rngTbl)
For Each rw In rng.Rows 'loop over affected rows
Me.Cells(rw.Row, PendingWriteCol).Value = "x"
Next rw
End If
End Sub
I want to click a button and take cell E27 value and paste it into cell E35.
Then, when I click it again, I want cell E27 value pasted into cell E36.
Then, I want E27 value pasted into cell E37
Basically, E27 is constantly changing and I want to be able to take "Screenshots" of it whenever I want using a macro.
This is the code I have so far. It will paste E27 into E35, but when run again, it doesn't paste E27 into E36 etc.
Sub DataTrend()
Dim inRng As Range, outCell As Range, inCell As Range
Set inRng = Range("E27")
Set outCell = Range("E35")
Application.ScreenUpdating = False
For Each inCell In inRng
outCell.Value = inCell.Value
Set outCell = outCell.Offset(8, 0)
Next inCell
Application.ScreenUpdating = True
End Sub
You would have to provide a method by which the macro can know which row to paste to. There are two systems to choose from.
Determine a location where a counter can be placed: perhaps a cell (on a hidden worksheet) or a custom document property. Each time the button is pressed that counter is advanced by 1, and the row in that counter is used to paste the copy to.
You might arrange your worksheet in such a way that the copy of E27 is always pasted to the next free cell at or below E37. This would do away with the need of a counter but would restrict the use of cells below row 37 in column E.
Your question doesn't specify which system you prefer. The code below chooses the second. It also doesn't require a button. It just records every change made to E27. Condition is that it's installed in the code module of the worksheet on which you want the action.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rt As Long ' Target row to write to
With Target
If .Address(0, 0) = "E27" Then
Rt = Application.Max(36, Cells(Rows.Count, "E").End(xlUp).Row) + 1
Cells(Rt, "E").Value = .Value
End If
End With
End Sub
If you prefer to operate the code with a button you can transplant the gist of the procedure to yours and install it in a standard code module, as you have already done.
Please bear with me as I am self-taught and very new to VBA coding.
I need help with a code for a work project to automatically/dynamically hide a column based on a row value within that column. In my example, based on a Yes/No data validation list in an alternate worksheet, the current worksheet will update and return the same "Yes" or "No" value. If the answer is "No", I need that column to automatically disappear once the user has chosen that option from the Data validation list.
The data set is as follows:
The Yes/No result is on Row 3, in the column range B:AR.
The results of Row 3 are as a result of a transcode formula from another worksheet.
Bonus points if the coding is truly dynamic, in that was I to add rows above Row 3, the code would automatically move to Row 4.
I have scoured the google realms and most code either doesn't update or is strenuously slow. An example of several codes I have attempted are below:
Sub Hide_Columns_Containing_Value()
Dim c As Range
For Each c In Range("B3:AR3").Cells
If c.Value = "No" Then
c.EntireColumn.Hidden = True
End If
Next c
End Sub
Hope a little faster
Sub Hide_Columns_Containing_Value( _
ByVal msg As String, _
ByVal r As Range)
Dim c As Range
Set c = r.Find(msg)
If Not c Is Nothing Then
c.EntireColumn.Hidden = True
End If
End Sub
So this is what you need to Do:
First Define a Named Range in the worksheet for the Rows you want to check No in. Benefit of Named Range is it is Dynamic, so if you add another row before 3rd row, it will dynamically move the Named Range to 4th Row.
Like this:
After Making the named range add this Code to the Worksheet you are on:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("roww")) Is Nothing Then
For Each cel In Range("roww")
If cel.Value = "No" Then Columns(cel.Column).EntireColumn.Hidden = True
Next
End If
End Sub
-Second Code to be added below the First One.
Sub hdd()
For Each cel In Range("roww")
If cel.Value = "No" Then Columns(cel.Column).EntireColumn.Hidden = True
Next
End Sub
Make Sure code is on the Correct sheet to work:
This will be a complete Dynamic code.
I can make one or the other of the below codes work, but need them both. The first locks cells in range upon data entry, the second inserts a date stamp when the final data entry in column D of each row is completed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("A8:D5005"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="Midnight"
xRg.Locked = True
Target.Worksheet.Protect Password:="Midnight"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("D8:D5005")
If Not Intersect(Target, rng) Is Nothing Then
Target.Offset(0, 1) = Now
Target.Offset.NumberFormat = "dd/mm/yyyy hh:mm:ss"
End If
End Sub
I'm still guessing a bit exactly what you're trying to do … but here is way to allow your users enter four data points ... and then to press button to add the data points to a protected list … and includes a time stamp.
First setup 4 data entry cells in A4 through to D4 by using the Format Cell option, make sure for these cells that Locked is unchecked on the Protection tab.
Next create a button and link the button to the following code:
Sub ButtonCode()
ActiveSheet.Unprotect Password:="A"
Range("A7:E7").Insert xlShiftDown
Range("A4:D4").Copy Range("A7:D7")
Range("E7") = Now()
Range("A7:E7").Interior.Color = rgbLightBlue
Range("A7:E7").Font.Color = rgbBlack
ActiveSheet.Protect Password:="A"
End Sub
As a once only step, protect the worksheet; my example consistently uses a password of "A". Note that your users will not need to enter the password at any time.
Once the sheet is setup, when the button is clicked, the code unlocks the sheet (allowing it to make edits), it move the existing data data down, copy the new data points to the top of the list, adds timestamp and some minimal formatting. It then re-enables protection so that the user can't overwrite the existing entries.
The screenshot below gives you an idea of what it might look like, including showing that A4:D4 need to be unlocked.
Maybe not the implementation direction you were thinking of … but the principles included in this example might work for you. All the best.
I'm not 100% sure of the structure of your worksheet, so here are the assumptions for my response. You only want the user to modify cells in the range "A8:D5005" … and somewhere on the sheet you want to record date/timestamp changes for cells changed.
So I would start by protecting the sheet by going to the Excel "Review" ribbon (not in VBA), and setting up an editable range as follows.
Before you close the dialog box, click on Protect Sheet so that the rest of the sheet is password protected.
Once you've done this … you can use something like the code below to record the date/timestamps. In this example … I record them in columns to the right of your editable range (given your editable data is only to Column D).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vIntersect As Variant
Set vIntersect = Application.Intersect(Target, Range("A8:D5005"))
If Not vIntersect Is Nothing Then
Application.EnableEvents = False
Target.Worksheet.Unprotect Password:="Midnight"
Target.Offset(0, 5) = Now
Target.Offset(0, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss"
Target.Worksheet.Protect Password:="Midnight"
Application.EnableEvents = True
End If
End Sub
I am trying to use a button in Excel to copy a certain range of cells from the active workbook to another workbook. The copying works perfectly when I specify a fixed range for each button in its assigned Macro but I'm stumped as to how to use the same Macro on each button and for the button's row number to indicate the row of data to be copied.
Every row contains 6 or so cells with the 7th containing the button. When the user presses this button the 6 cells on the same row as the row containing the pressed button need to be copied.
I am a complete novice when it comes to VBScript but much googling has got me this far:
Sheets("SurfaceThreats").Range("A4:F4")Copy_
Sheets("ORBAT").Cells(Rows.Count,1).End(x1Up).Offset(1,0)
Surely there is a more elegant solution than assigning a different, fixed range, Macro to every button.
See this screenshot
And this is the code for the Select Row(s) button
Option Explicit
Private Sub CommandButton1_Click()
Dim Ret As Range, rng As Range
Dim lRow As Long
On Error Resume Next
Set Ret = Application.InputBox("Please select the row", Type:=8)
On Error GoTo 0
If Not Ret Is Nothing Then
For Each rng In Ret.Rows
'~~> Get the last row in sheets "ORBAT" where you want to copy
With Sheets("ORBAT")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
'~~> Copy the rows
Sheets("SurfaceThreats").Range("A" & rng.Row & ":F" & rng.Row).Copy _
Sheets("ORBAT").Cells(lRow, 1)
Next
End If
End Sub
You can't create a generic button handler, but you can dynamically create the buttons and the macros to handle them. But it's quite a lot of work and you'll have to start creating macros dynamically. (this can cause problems with anti-virus software sometimes i think).
You could use the Worksheet_OnBeforeDoubleClick event to create "fake" buttons
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Target.Worksheet.Columns(1)) Is Nothing Then
MsgBox "You Clicked " & Target.Address
' call your generic handler here passing the Target.Address or Target.Row
Cancel = True
End If
End Sub
Using this code, if you double click any cell in the "A" column you'll get a message box saying what cell you clicked.
Its not the best of ideas, some users might not understand that it is a button.