Create an Asset List Using Excel Macro - vba

I am trying to write a code using Macro, but with no luck.
The task can be simply defined as, when the user enters a Serial Number such "AB123" anywhere in column I, a list should appear automatically in columns in (J, K, L). please the the attached picture
If there is any other way to do that without using Macro, I am glad to hear it.
Thank you in advance, I hop that I make myself clear.
The pic. shows whenever the RED Serial Number is entered. The Highlighted columns in green should appear.

Something for you to think about. Put this code in your Sheet. Double-click the sheet name and a windoe to enter code will appear.
Option Explicit
Public Sub Worksheet_Activate()
Me.Range("J:L").EntireColumn.Hidden = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Me.Range("I:I")) Is Nothing Then
If Target.Cells.CountLarge = 1 Then
If Target.Value = "AB1234" Then
Me.Range("J:L").EntireColumn.Hidden = False
Else
Me.Range("J:L").EntireColumn.Hidden = True
End If
Else
'Nothing
End If
End If
End Sub
Private Sub Worksheet_Deactivate()
Me.Range("J:L").EntireColumn.Hidden = False
End Sub

Related

How to Detect if a Cell is Changed by an "=IF()" Formula and not by a User

I read a lot of pages saying that, but none of them put the solution if the value change by an "if function" not by hand.
The code I get is that:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A18:A30")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
On Error GoTo Finalize 'to re-enable the events
MsgBox "You changed THE CELL!"
Finalize:
Application.EnableEvents = True
End Sub
It only works if I change the value by hand.
Thank you in advance.
Another solution; instead of triggering your function every time when your worksheet recalculates, add a function in a module:
Function DetectChange() As Integer
MsgBox "You changed THE CELL!"
DetectChange = 0
End Function
Assuming the outcome of your formula is numeric:(otherwise outcome of function must be a empty string and the "+" must be "&")
Add to your IF-formula at the end ...+Detectchange()
Now there will be a msgbox only when your formula is recalculated
Edit by Darren Bartrup-Cook:
I found this code gave worked when the formula recalculated. It didn't fire if I changed a cell that doesn't affect the cell it's entered to and it didn't fire using Calculate Now or Calculate Sheet.
It did occasionally fire for all formula that I used the function in, but that seemed to be when I was debugging - maybe further investigation needed.
Public Function DetectChange()
MsgBox "You changed cell " & Application.Caller.Address
End Function
e.g.:
=IF(A1=1,A2,A3) & DetectChange() entered in cell A4 displays the message "You changed cell $A$4" if cells A1, A2 or A3 is changed.
Write this in Sheet1 and run the TestMe sub:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1:A30")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finalize
MsgBox "You changed THE CELL!"
Finalize:
Application.EnableEvents = True
End Sub
Sub TestMe()
Range("A1") = 34
End Sub
It has worked quite ok on my PC.
If the cell is changed by a built-in Excel function, then the comment of #Vincent G states the correct answer:
Worksheet_Change event occurs when cells on the worksheet are changed by the user or by an external link. and This event does not occur when cells change during a recalculation. Use the Calculate event to trap a sheet recalculation.
If you want to track the calclulation event based on some changes at Range(A18:A30) this is a working solution:
Add a new Worksheet to your Workbook (Sheet2);
In the current Worksheet write the Calculate event:
Private Sub Worksheet_Calculate()
Dim cell As Range
For Each cell In Sheet2.Range("A18:A30")
If cell <> Sheet1.Range(cell.Address) Then
cell = Sheet1.Range(cell.Address)
End If
Next cell
End Sub
In the Sheet2 write an event, catching the changes.
As simple as #Vincent G says.
Private Sub Worksheet_Calculate()
Call YourFunction
End Sub

VBA cells are not highlighted

Its a protected worksheet/workbook and I have a code that will throw a prompt for the user, whether to edit the sheet or not. Cells are editable, but the problem is cells are not getting highlighted with border. So its difficult for the user to know which cells is he working on.
I have 2 sheets here, Corefiller and Ad-filler, if dropdown on corefiller sheet is "No". User gets a prompt when he selects the sheet, he clicks ok to edit the sheet or cancel if he doesnt want to edit.
Code on Sheet "Ad-filler"
Option Explicit
Private mMessageDisplayed As Boolean
Private Sub Worksheet_Activate()
Carry
End Sub
Code on a module.
Public Sub Carry()
If ActiveSheet.ProtectContents And Not mMessageDisplayed Then
mMessageDisplayed = True
If ThisWorkbook.Sheets("Corefiller").Range("E29") = "NO" Then
If MsgBox("Click OK to include Filler for this request", vbOKCancel + vbInformation) = vbOK Then
ThisWorkbook.Worksheets("Corefiller").Range("E29") = "YES"
With ThisWorkbook.Sheets("Ad-filler")
.Range("E13:E14").Locked = False
End With
Else
With ThisWorkbook.Sheets("Ad-filler")
.Range("E13:E14").Locked = True
End With
End If
Else
Exit Sub
End If
End If
End Sub
Whats wrong in my code? why the cell is not highlighted. If i try to use protect/unprotect in the code, cells on the first sheet (Corefiller) will not be highlighted and I have to click on other sheets and come back to get the cell highlighted.
Can you restart, implement this and check whether the problem still exists:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 0
Target.Interior.ColorIndex = 3
End Sub

Run Macro Dropdown List Excel

I wrote this Macro out to copy and paste info from a previous sheet to the active sheet. I want to make this into a dropdown list but when using data validation, the macro doesn't run when it is picked. Attached is my code and I am wondering should I make a list box or should I stick with data validation? I know there's a way to make a macro run once clicked in a click box
Sub WorkDay1()
ActiveSheet.Range("A6:H44").Value = Worksheets("Route Sheet - Manhattan 1").Range("A6:H44").Value
End Sub
Sub WorkDay2()
ActiveSheet.Range("A6:H44").Value = Worksheets("2").Range("A6:H44").Value
End Sub
Sub WorkDay3()
ActiveSheet.Range("A6:H44").Value = Worksheets("3").Range("A6:H44").Value
End Sub
Sub WorkDay4()
ActiveSheet.Range("A6:H44").Value = Worksheets("4").Range("A6:H44").Value
End Sub
Assuming your dropdown list is in cell A1.
Paste this code into the worksheets code module.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A1")) Is Nothing Then
Select Case Target.Value
Case "WorkDay1"
WorkDay1
Case "WorkDay2"
WorkDay2
Case "WorkDay3"
WorkDay3
Case "WorkDay4"
WorkDay4
End Select
End If
Application.EnableEvents = True
End Sub
In the VBA Project explore double click the Sheet that you wish to run the macro on. This will open up the code module for that sheet. Then paste the code into that module.
Adding this colud will update the values when you select the worksheet.
Private Sub Worksheet_Activate()
Select Case Range("A1")
Case "WorkDay1"
WorkDay1
Case "WorkDay2"
WorkDay2
Case "WorkDay3"
WorkDay3
Case "WorkDay4"
WorkDay4
End Select
End Sub

Excel Userform with Textbox, how to toggle through values in range of textbox

Purpose: Click on a cell in a range (Range: Column K:K on excel worksheet). Once you click on a specific cell in column K, userform pops up with cell value using following code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
Credit_Information.TextBox1.Value = Target.Value
Credit_Information.Show
End If
End Sub
My question, is depending on where I click on column K, I want to use two buttons on my userform (Previous and Next) to move up and down column K and see the values of the cell dynamically change on my userform. Is this possible? Please let me know if any clarification is needed.
Just add the two command buttons to your userform.
Name one of the buttons cmdNext and give it a caption of "Next".
Name the other button cmdPrev and give it a caption of "Previous".
Then, in the userform code module, place these routines:
Private Sub cmdNext_Click()
ActiveCell(2).Select
End Sub
Private Sub cmdPrev_Click()
If ActiveCell.Row > 1 Then ActiveCell(0).Select
End Sub
That's it.
Note: if you want you can add code to ensure that the ActiveCell is in column K before allowing the new selections:
If ActiveCell.Column = 11 Then ...
Perfect, Thanks!
I also found out that using Offset worked for me too in this manner. I'm not sure however if I'm breaking any conventions by doing this.
Private Sub CommandButton1_Click()
ActiveCell.Offset(-1).Activate
End Sub
Private Sub CommandButton2_Click()
ActiveCell.Offset(1).Activate
End Sub
It is possible, but I would create another procedure for that. What you could do is declare a public variable in your userform & set it equal to the range Target. Then you could call another procedure from the userform on each button click and redefine the selected range after each click.
So, at the top of your userform do this:
Public selected_cell as Range
Then for the up button:
Private Sub ButtonUp.Click()
If selected_cell.Row < 2 Then Exit Sub
selected_cell.Rows(0).Select
Set selected_cell = selected_cell.Rows(0)
me.TextBox1.Value = selected_cell
End Sub
And the down button would be:
Private Sub ButtonDown.Click()
selected_cell.Rows(2).Select
Set selected_cell = selected_cell.Rows(2)
me.TextBox1.Value = selected_cell
End Sub
Now let's make your code like this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
With Credit_Information
Set .selected_cell = target
.TextBox1.Value = Target.Value
.Show
End With
End If
End Sub

Excel Automatically Open Dropdown List with Focus / NumLock issue

I have a group of cells in my worksheet that use a data validation list. It works great, but I'd like the list to dropdown automatically when one of these cells gets the focus. I found some code online to make this work.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Worksheet.Name = "Sheet1" And Target.Column = 1 Then
Application.SendKeys ("%{down}")
End If
End Sub
Courtesy of: http://howoffice.com/automatically-open-the-drop-down-list-when-a-cell-get-focus-in-excel/
However, the issue I'm having is with the SendKeys causing the NumLock to toggle on and off. I looked this up and it's a known issue with the command.
Are there any other alternatives to the SendKey command to accomplish what I'm looking to do here?
Any help is appreciated.
This code works for me:
Courtesy of: On focus after tabbing of Excel drop down, automatically show list for selection
Private Sub Worksheet_SelectionChange(ByVal Target As Range
On Error GoTo Err1:
If Target = Range("I5") Then
Application.SendKeys ("%{UP}")
End If
If Target = Range("I6") Then
Application.SendKeys ("%{UP}")
End If
If Target = Range("I7") Then
Application.SendKeys ("%{UP}")
End If
Err1:
'do nothing
End Sub
And here's the code with SDB MadDog's corrections:
If you want it to apply to all cell's with data validation
( 'On focus after tabbing of Excel drop down, automatically show list for selection )
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Err1:
If Target.Cells.Count = 1 Then
If Target.Validation.InCellDropdown = True Then
Application.SendKeys ("%{UP}")
End If
End If
Err1:
'do nothing
End Sub
However, it changes my NUMLOCK status (toogle ON / off) everytime!
He mentioned he fixed it with an API, I tried, but it doesn't work because it can't get numlock status read correctly (this one http://www.freevbcode.com/ShowCode.asp?ID=1151)
But hope this helps someone in need!
this code works for me :
SendKeys "%{down}", True
DoEvents
SendKeys "{SCROLLLOCK}"