I have the following code:
Sub YYY()
Dim rCell As Range
Dim lColor As Long
Dim rColored As Range
lColor = vbYellow
Set rColored = Nothing
For Each rCell In Selection
I would like to change it that it will check it without selection (automatically)
meaning, that in every dynamic workbook it will return if there are or aren't yellow cells
thanks in advance!
Related
I have a code which I would like to use on multiple sheets, except one sheet. But applying the code to alle sheets is also fine.
Here is the code that I would like to adjust. I am have currently applied it to Excel 2011 in OS X , but I would like to use it for Excel 2010 in Windows.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim the_selection As String
Dim month_in_review As String
the_selection = Sheet1.Range("A1")
Dim Rep As Integer
For Rep = 2 To 379
the_column = GetColumnLetter_ByInteger(Rep)
month_in_review = Sheet1.Range(the_column & "1")
If the_selection = month_in_review Then
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
End Sub
In the module I have the following code:
Public Function GetColumnLetter_ByInteger(what_number As Integer) As String
GetColumnLetter_ByInteger = ""
MyColumn_Integer = what_number
If MyColumn_Ineger <= 26 Then
column_letter = ChrW(64 + MyColumn_Integer)
End If
If MyColumn_Integer > 26 Then
column_letter = ChrW(Int((MyColumn_Integer - 1) / 26) + 64) & ChrW(((MyColumn_Integer - 1) Mod 26) + 65)
End If
GetColumnLetter_ByInteger = column_letter
End Function
If you're asking for one sheet to detect the change in cell "A1" and then to hide/unhide columns on multiple sheets then the prior answers to your question will serve you nicely.
If, on the other hand, you're asking to detect a change in cell "A1" on any sheet and then to hide/unhide columns on just the changed sheet, then the code below will work for you. It accesses the Workbook_SheetChanged event at Workbook level.
A few points about your code:
You can reference cells using their integer or address values with the .Cell property, so Sheet1.Cells(1, 1) is the same as Sheet1.Cells(1, "A"). The same applies to the .Columns property. So there's no real need to convert your integer values to a string. See #Florent B's answer for a good example of this.
Wherever possible, minimise looping sheet interactions as these are very time-consuming. So rather than loop through the columns and hide/unhide each one individually, you could assign them to ranges within your loop and then hide/unhide the ranges all in one go at the end of your loop. If you must interact with the sheet on each iteration of your loop, then set the Application.ScreenUpdating property to false before the start of your loop. There's an example of this property in the sample code below.
Put this in your Workbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const TARGET_ADDRESS As String = "A1"
Dim cell As Range
Dim hiddenCols As Range
Dim unhiddenCols As Range
Dim selectedMonth As String
Dim monthInReview As String
Dim c As Integer
'Ignore event if not a target worksheet
If Sh.Name = "Not Wanted" Then Exit Sub
'Ignore event if not in target range
Set cell = Target.Cells(1)
If cell.Address(False, False) <> TARGET_ADDRESS Then Exit Sub
'Criteria met, so handle event
selectedMonth = CStr(cell.Value)
For c = 2 To 379
Set cell = Sh.Cells(1, c)
monthInReview = CStr(cell.Value)
'Add cell to hidden or unhidden ranges
If monthInReview = selectedMonth Then
If unhiddenCols Is Nothing Then
Set unhiddenCols = cell
Else
Set unhiddenCols = Union(unhiddenCols, cell)
End If
Else
If hiddenCols Is Nothing Then
Set hiddenCols = cell
Else
Set hiddenCols = Union(hiddenCols, cell)
End If
End If
Next
'Hide and unhide the cells
Application.ScreenUpdating = False 'not really needed here but given as example
If Not unhiddenCols Is Nothing Then
unhiddenCols.EntireColumn.Hidden = False
End If
If Not hiddenCols Is Nothing Then
hiddenCols.EntireColumn.Hidden = True
End If
Application.ScreenUpdating = True
End Sub
You can use a for each loop to loop through all the Worksheets, and check the worksheet name if it should be skipped. Then apply your code onto the sheet selected.
Something like:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Skip Sheet" Then
Dim the_selection As String
Dim month_in_review As String
the_selection = ws.Range("A1")
Dim Rep As Integer
For Rep = 2 To 379
the_column = GetColumnLetter_ByInteger(Rep)
month_in_review = ws.Range(the_column & "1")
If the_selection = month_in_review Then
ws.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
ws.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
Next ws
End If
End Sub
I wasn't entirely sure what you wished to achieve, so i put ws in the place of Sheet1.
This example will show/hide the columns in all the other sheets if the first cell of the column match/differ with the cell A1 of the sheet where this code is placed:
Private Sub Worksheet_Change(ByVal Target As Range)
' exit if not cell A1
If Target.row <> 1 Or Target.column <> 1 Then Exit Sub
Dim sheet As Worksheet
Dim the_selection As String
Dim month_in_review As String
Dim column As Integer
the_selection = Target.Value
' iterate all the sheets
For Each sheet In ThisWorkbook.Worksheets
' skip this sheet
If Not sheet Is Me Then
' iterate the columns
For column = 2 To 379
' get the first cell of the column
month_in_review = sheet.Cells(1, column).Value
' hide or show the column if it's a match or not
sheet.Columns(column).Hidden = month_in_review <> the_selection
Next
End If
Next
End Sub
Excel VBA beginner coming back for more. I am creating a macro that does the following two things:
1) Searches through multiple worksheets in a single workbook for a specific piece of data (a name), variable A below
2) If that name appears, to copy a specific range of cells from the worksheet (variable X below) to the master file (variable B below)
Sub Pull_X_Click()
Dim A As Variant 'defines name
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination for data pulled from report
Dim ws As Worksheet
Dim rng As Range
A = Workbooks("B.xlsm").Worksheets("Summary").Range("A1").Value
Set B = Workbooks("B.xlsm")
Set X = Workbooks.Open("X.xlsm")
Set Destination = Workbooks("B").Worksheets("Input").Range("B2:S2")
'check if name is entered properly
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
Worksheets("Reference").Activate
Exit Sub
End If
X.Activate
For Each ws In X.Worksheets
Set rng = ws.Range("A" & ws.Rows.Count).End(xlUp)
If InStr(1, rng, A) = 0 Then
Else
X.ActiveSheet.Range("$A$2:$DQ$11").AutoFilter Field:=1, Criteria1:=A
Range("A7:CD7").Select
Selection.Copy
Destination.Activate
Destination.PasteSpecial
End If
Next ws
Application.ScreenUpdating = False
End Sub
UPDATE: I managed to resolve the previous compile error, and it seems that the code (should?) work. However, it gets to this step:
X.Activate
...and then nothing happens. There's no run-time errors or anything, but it doesn't seem to be searching through the file (variable X) or pulling any of the data based on the presence of variable A. Any thoughts?
What I would've done is loop through the rows and evaluate the column in which the necessary data appears and then avoiding copy/paste just make the target range equal to the source range:
Sub SearchNCopy()
Dim A As String 'The String you are searching for
Dim b As String ' the string where you shall be searching
Dim wbs, wbt As Workbook ' Declare your workbooks
Dim wss As Worksheet
Dim i, lrow As Integer
Set wbt = Workbooks("B.xlsm") 'Set your workbooks
Set wbs = Workbooks.Open("X.xlsm")
A = wbt.Worksheets("Summary").Range("A1").Value
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
Worksheets("Reference").Activate
Exit Sub
End If
For Each wss In wbs.Worksheets 'Loop through sheets
lrow = wss.Cells(wss.Rows.Count, "A").End(xlUp).Row 'Find last used row in each sheet - MAKE SURE YOUR SHEETS DONT HAVE BLANKS BETWEEN ENTIRES
For i = 1 To lrow Step 1 'Loop through the rows
b = wss.Range("A" & i).Value 'Assign the value to the variable from column a of the row
If Not InStr(1, b, A) = 0 Then 'Evaluate the value in the column a and if it contains the input string, do the following
wbt.Worksheets("Input").Range("B2:CC2") = wss.Range("A" & i & ":CD" & i) 'copies the range from one worksheet to another avoiding copy/paste (much faster)
End If
Next i
Next wss
End Sub
I have absolutely no experience programming in excel vba other than I wrote a function to add a data stamp to a barcode that was scanned in on our production line a few weeks back, mainly through trial and error.
Anyways, what I need help with right now is inventory is coming up and every item we have has a barcode and is usually scanned into notepad and then manually pulled into excel and "text to columns" is used. I found the excel split function and would like a little bit of help getting it to work with my scanned barcodes.
The data comes in in the format: 11111*A153333*11/30/11 plus a carriage return , where the * would be the delimiter. All the examples I've found don't seem to do anything, at all.
For example here is one I found on splitting at the " ", but nothing happens if I change it to *.
Sub splitText()
'splits Text active cell using * char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(ActiveCell.Value, "*")
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
End Sub
And this is applied in the Sheet1 code section, if that helps.
It really can't be this complicated, can it?
Edit: Trying to add in Vlookup to the vba.
So as I said below in the comments, I'm now working on getting the vlookup integrated into this, however it just returns N/A.
Here is the sub I wrote based on the link below
Public Sub vlook(ByRef codeCell As Range)
Dim result As String
Dim source As Worksheet
Dim destination As Worksheet
Set destination = ActiveWorkbook.Sheets("Inventory")
Set source = ActiveWorkbook.Sheets("Descriptions")
result = [Vlookup(destination!(codeCell.Row, D), source!A2:B1397, 2, FALSE)]
End Sub
And I was trying to call it right after the For loop in the worksheet change, and just created another for loop, does this/should this be a nested for loop?
Just adding the code to the VBA behind the worksheet won't actually cause it to get called. You need to handle the worksheet_change event. The following should help:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim cell As Range
For Each cell In Target.Cells
If cell.Column = 1 Then SplitText cell
Next
Application.EnableEvents = True
End Sub
Public Sub SplitText(ByRef codeCell As Range)
'splits Text active cell using * char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(codeCell.Value, "*")
totalVals = UBound(splitVals)
Range(Cells(codeCell.Row, codeCell.Column), Cells(codeCell.Row, codeCell.Column + totalVals)).Value = splitVals
End Sub
If you want to process the barcodes automatically on entering them, you need something like this (goes in the worksheet module).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim splitVals As Variant
Dim c As Range, val As String
For Each c In Target.Cells
If c.Column = 1 Then 'optional: only process barcodes if in ColA
val = Trim(c.Value)
If InStr(val, "*") > 0 Then
splitVals = Split(val, "*")
c.Offset(0, 1).Resize( _
1, (UBound(splitVals) - LBound(splitVals)) + 1 _
).Value = splitVals
End If
End If 'in ColA
Next c
End Sub
I've got a Macro that I run that writes a copyright header to my document. Currently when the header is written, the cursor is left at the end of the header.
What I'd like to be able to do is capture the current location, write the header, and then return the cursor to the original location.
Does anyone know how this can be accomplished?
I think I've got it.
Dim selection As TextSelection = DTE.ActiveDocument.Selection
''# store the original selection and cursor position
Dim topPoint As TextPoint = selection.TopPoint
Dim bottomPoint As TextPoint = selection.BottomPoint
Dim lTopLine As Long = topPoint.Line
Dim lTopColumn As Long = topPoint.LineCharOffset
Dim lBottomLine As Long = bottomPoint.Line
Dim lBottomColumn As Long = bottomPoint.LineCharOffset()
Dim verticalOffset As Integer = 0
''# do a bunch of stuff that adds text to the page
''# Restore cursor to previous position
selection.MoveToLineAndOffset(lBottomLine + verticalOffset, lBottomColumn)
selection.MoveToLineAndOffset(lTopLine + verticalOffset, lTopColumn, True)
This is all nested within a Macro I wrote to automatically add a copyright header to each code file.
I have a TreeView in excel 2007 with checkboxes.
I want the checkboxes to be all selected when the tree is populated
I want that when I select/unselect a parent node of the list, all its children are selected/unselected
Here is the code I have written so far:
Private Sub UserForm_Initialize()
'Set control defaults
With Me
.CommandButton1.Caption = "Close"
.Label1 = vbNullString
.ZonesTree.LineStyle = tvwRootLines
End With
'Populate the Treeview
Call TreeView_Populate
End Sub
Private Sub TreeView_Populate()
Dim wbBook As Workbook
Dim wsZones As Worksheet
Dim rngZones As Range
Dim rngCinemas As Range
Dim lngRows As Long
Set wbBook = ThisWorkbook
Set wsZones = wbBook.Worksheets("Cinemas")
'lngRows = wsZones.Range("A65536").End(xlUp).row
lngRows = wsZones.UsedRange.Rows.Count
Set rngZones = wsZones.Range("A1:A" & lngRows)
Dim rngBC As Range
Set rngBC = wsZones.Range("B1:C" & lngRows)
Dim rCell As Range
Dim lastCreatedKey As String
Dim rowCount As Integer
Dim currentRowRange As Range
rowCount = 1
lastCreatedKey = ""
With Me.ZonesTree.Nodes
'Clear TreeView control
.Clear
For Each rCell In rngZones
If Not rCell.Text = "" Then
.Add Key:=rCell.Text, Text:=rCell.Text
lastCreatedKey = rCell.Text
Else
Set currentRowRange = rngBC.Rows(rowCount)
.Add Relative:=lastCreatedKey, relationship:=tvwChild, Key:=currentRowRange.Cells(, 2).Text, Text:=currentRowRange.Cells(, 1).Text
End If
rowCount = rowCount + 1
Next rCell
End With
End Sub
Private Sub Treeview1_NodeClick(ByVal Node As MSComctlLib.Node)
Me.Label1.Caption = Node.Key
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
This tree picks data from a sheet in this manner:
---A---------B---------C---------D
ParentNode
------------ChildNode
------------ChildNode
------------ChildNode
ParentNode
------------ChildNode
------------ChildNode
ParentNode
------------ChildNode
etc... (you get the idea, its an excel sheet...)
What is the vba code to select/unselect the boxes?? I have been searching a lot and couldn't find an answer to this easy problem....
Thx in advance!
On access which I assume uses the same control the property you use is .checked
Just set that to true for the boxes you want ticked
Here is a code sample
Set iNode = objTree.Nodes.Add(strParent,tvwChild, strKey, strText)
iNode.Checked = true
You should be to adapt it to work in excel