Hi guys I´m new at VBA programming and have some difficulties...
I have an UserForm with OptionButtons. So what I want is, when i Click on a OptionButton, the code will search in the Columns in Tabell2 and when found, insert a new Column ToLeft.
My code is obviously wrong and/or bad written...
Private Sub OptionButton1_Click()
Dim cl As Range
If OptionButton1.Value = True Then Search "10700"
For Each cl In Worksheets("Tabelle2").Range("1:1")
If cl = "10700" Then cl.EntireColumn.Activate
End If
End Sub
Private Sub AddColumn()
Dim cl As Range
For Each cl In Worksheets("Dokumentenübersicht").Range("1:1")
If cl = Active Then
cl.EntireColumn.Insert Shift:=xlToLeft
End If
cl.Offset(0, 1) = "role"
Next cl
End Sub
You appear to be working between different sheets but here is a general outline.
The following assumes you are both searching and inserting in Worksheets("Tabelle2").
It uses the Range.Find method to locate the string of interest. The range to search is currently set at row 1 as per your code.
Option Explicit
Private Sub OptionButton1_Click()
Dim cl As Range
If OptionButton1 Then
Set cl = Worksheets("Tabelle2").Range("1:1").Find("10700")
If Not cl Is Nothing Then cl.EntireColumn.Insert Shift:=xlToLeft
End If
End Sub
Related
In the code below, I check if the value of Sheet2 cell A1 is contained in combobox1 list and, if found, put it in the 'selection mode'. But it does not work. Which part of the code should be corrected?
Private Sub UserForm_Initialize()
Set xRg = Worksheets("Sheet1").Range("A1:B5")
Me.ComboBox1.List = xRg.Columns(1).Value
End Sub
Private Sub CommandButton1_Click()
Dim foundRng As Range
Set findrange = Sheets("Sheet1").Range("A1:B5")
Set foundRng = findrange.Find(Sheets("Sheet2").Range("A1"))
If foundRng Is Nothing Then
MsgBox "Nothing found"
Else
MsgBox "I Found"
Me.ComboBox1.ListIndex = foundRng.Value
End If
End Sub
Declare variables and provide for correct data types
I didn't change your code too much, but would like to give you some hints:
Set Option Explicit to compel yourself to declare variables (objects).
Provide for input cases in your Sheet2!A1 cell where a type mismatch could occur if you compare a string or an empty string (and not a number) against ListIndex numbers.
It's recommended to fully qualify your range references (fqrr).
Prefer to use the term Worksheets if you are referring to worksheets only.
Check Stack Overflow's Help Tour
regarding How do I ask a good question?, and,
How to create a Minimal, Complete, and Verifiable example
Try to learn something about error handling and Debugging VBA in order to be in the position to give more precise information about occurring errors. "It doesn't work" is like a red rag for a bull to more experienced programmers at this site, be more precise here :-;
Some minor changes ...
Option Explicit ' declaration head of your UserForm code module
Dim xrg As Range ' possibly declared here to be known in all UserForm procedures
Private Sub UserForm_Initialize()
Set xrg = ThisWorkbook.Worksheets("Sheet1").Range("A1:B5") ' << fully qualified range reference (fqrr)
Me.ComboBox1.List = xrg.Columns(1).Value
End Sub
Private Sub CommandButton1_Click()
Dim foundRng As Range, findrange As Range
Set findrange = ThisWorkbook.Worksheets("Sheet1").Range("A1:B5") ' fqrr
Set foundRng = findrange.Find(Thisworkbook.Worksheets("Sheet2").Range("A1")) ' fqrr
If foundRng Is Nothing Then
MsgBox "Nothing found"
Me.ComboBox1.ListIndex = -1
ElseIf foundRng.Value = vbNullString Then
MsgBox "Empty search item"
Me.ComboBox1.ListIndex = -1
Else
MsgBox "1 item found"
If IsNumeric(foundRng.Value) Then
Me.ComboBox1.ListIndex = CLng(foundRng.Value) + 1
Else
Me.ComboBox1.ListIndex = foundRng.Row - 1
End If
End If
End Sub
Recommended link
You can find a helpful guide about Debugging VBA at Chip Pearson's site.
Addendum due to comment
In order to define a dynamic range without following empty rows you could rewrite the Initialize procedure as follows:
Private Sub UserForm_Initialize()
Dim n& ' ... As Long
With ThisWorkbook.Worksheets("Sheet1")
n = .Range("A" & .Rows.Count).End(xlUp).Row
Set xrg = .Range("A1:B" & n) ' << fully qualified range reference
End With
Me.ComboBox1.List = xrg.Columns(1).Value
End Sub
Good luck for future learning steps :-)
First of all, I know nothing about macros and vba used in Excel and other applications. I copied from the internet and ran the following code in sheet 1 as:
Option Explicit
Private Sub Worksheet_Activate()
Dim r As Range, c As Range
Set r = Range("a129:a1675")
Application.ScreenUpdating = False
For Each c In r
If Len(c.Text) = 0 Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
Application.ScreenUpdating = True
End Sub
The code is working fine in Sheet 1 but the same code but with different range,i.e. "a5:a100" is not working for sheet 2.
Do we need to deactivate the code for sheet 1?
Thanks in Advance,
Regards,
ID
You might create one sub like this one and place it in a standard code module, for example Module1' (you will have to insert it: Right-click in the Project explorer while selecting the workbook's VBA project, selectInsertandModule`).
Option Explicit
Sub HideRows(Rng As Range)
Dim Ws As Worksheet
Dim R As Long
Application.ScreenUpdating = False
With Rng
Set Ws = .Worksheet
For R = 1 To .Rows.Count
Ws.Rows(.Row).EntireRow.Hidden = Not CBool(Len(.Cells(R)))
Next R
End With
Application.ScreenUpdating = True
End Sub
Then call that same sub from all the worksheets to be affected, each one with a different range as argument.
Option Explicit
Private Sub Worksheet_Activate()
HideRows Range("A1:A1675")
End Sub
The idea is that the range should have only one column. If you feed a multi-column range the Hidden status of the row will depend upon the last cell's content in each row.
I have a list with background colors in "A" column and value in their ceil is the name of colors.
I want to do that when I select a cell with a background color this will change the value of "C1" value to the value that have in "A" column.
(this is not the my real name of the colors, I have a specific name for each colors.)
Like vlookup but with background colors and in the same ceil.
For example:
Thank you!
Put this in the code section of the worksheet :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If dictColours.Exists(.Interior.ColorIndex) Then
Sheets("Sheet1").Range("C1").Value = dictColours(.Interior.ColorIndex)
End If
End With
End Sub
And add this to a new module, replacing the sheet reference:
Public dictColours As Scripting.Dictionary
Sub test()
Set dictColours = New Scripting.Dictionary
Dim rngTarget As Range
Set rngTarget = Sheets("Sheet1").Range("A1")
Do While rngTarget.Value <> ""
dictColours.Add rngTarget.Interior.ColorIndex, rngTarget.Value
Set rngTarget = rngTarget.Offset(1, 0)
Loop
End Sub
Think of using the conditional formatting.
elaborating on the very fine solution form Will I'd propose the following alternative code to be entirely put in the code section of the relevant worksheet
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dictColours As Scripting.Dictionary
Set dictColours = GetDictColours(Target.Parent)
With Target
If dictColours.Exists(.Interior.ColorIndex) Then
.Parent.Range("C1").Value = dictColours(.Interior.ColorIndex)
End If
End With
End Sub
Function GetDictColours(sht As Worksheet) As Scripting.Dictionary
Dim i As Long
Set GetDictColours = New Scripting.Dictionary
Do While sht.Range("A1").Offset(i) <> ""
GetDictColours.Add sht.Range("A1").Offset(i).Interior.ColorIndex, sht.Range("A1").Offset(i).Value
i = i + 1
Loop
End Function
aside from some stylistic choices (everyone has his own favorites), it should be more simple for the OP to handle, he being (as he himself stated) a total VBA beginner!
The idea was to create a variable that would save the changes made to it from previous use of the macro. I have a userform that pulls values from a range and populates unique values in a listbox. I then want to be able to add selected values to my dictionary/collection and save the change. Once all necessary changes have been made, the macro should use the dictionary variable as criteria for an autofilter.
My question is two fold, what class should I use to accomplish this? How can a use this variable to autofilter my worksheet? Userform code is below:
The First bit of code is for the "Add" command button. It is supposed to take the selected value(s) in the listbox and add them to the dictionary titled "Market". The code after that pulls the values from a recently opened excel workbook an displays unique values in the listbox. Listbox2 holds all previous values from past uses of the macro. I want to add a "Delete" button to the userform to tidy up the list if necessary. The two public variables below are actually located on the main macro module, this would allow me to store the values in the dictionary after the userform has stopped running.
Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Market.Add ListBox1.List(i)
Set Market = New Collection
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim myList As Collection
Dim myRange As Range
Dim ws As Worksheet
Dim myVal As Variant
Dim Col As Integer
Set ws = ActiveWorkbook.Sheets("Daily Unconfirmed")
Col = WorksheetFunction.Match("Marketer", ws.Range("3:3"), 0)
Set myRange = ws.Range(Cells(4, Col), Cells(4, Col).End(xlDown))
Set myList = New Collection
On Error Resume Next
For Each mycell In myRange.Cells
myList.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0
For Each myVal In myList
Me.ListBox1.AddItem myVal
Next myVal
Public item As Variant
Public Market As Collection
Market.Add "Al D"
Market.Add "B Collins"
Market.Add "B G"
Market.Add "C Huter"
For Each item In Market
Me.ListBox2.AddItem item
Next item
End Sub
Since AutoFilter runs from an array, I would build the array dynamically and use it in a filtering sub:
Dim ary()
Sub MAIN()
Call BuildDynamicArray
Call FilterMyData
End Sub
Sub BuildDynamicArray()
Dim inString As String
i = 1
While 1 = 1
x = Application.InputBox(Prompt:="Enter a value", Type:=2)
If x = False Then GoTo out
ReDim Preserve ary(1 To i)
ary(i) = x
i = i + 1
Wend
out:
End Sub
Sub FilterMyData()
ActiveSheet.Range("$A$1:$A$10").AutoFilter Field:=1, Criteria1:=ary, Operator:=xlFilterValues
End Sub
I work with sheets named; Rev00, Rev01, Rev02 etc - among other sheets in my workbook.
It would be very helpful (in order to compare the sub-summaries of different revisions) to set the exact same multiple-filter - as set in active sheet - in only all sheets beginning with "Rev".
This action should most wanted be activated by double Click in Range("A1") or somewhere like that (I dont want button on this one).
If possible next double Click in Range("A1") should reset filters.
Sub Test()
Dim ws As Worksheet, str As String
For Each ws In Worksheets
str = Left(ws.Name, 3)
If str = "Rev" Then
' set filter as in active.sheet
End If
Next ws
End Sub
... and I am stuck ....
will anyone guide me on this?
Yes it is possible. :) Here is a basic sample on how it should work.
Sub Test()
Dim ws As Worksheet, str As String
For Each ws In Worksheets
str = Left(ws.Name, 3)
If UCase(str) = "REV" Then
With ws
'~~> Remove any filters
.AutoFilterMode = False
With <YOUR RANGE>
.AutoFilter Field:=<RELEVANT FIELD>, _
Criteria1:=<YOUR CRITERIA>
'
'~~> Rest of the code
'
End With
'~~> Remove any filters
'.AutoFilterMode = False
End With
End If
Next ws
End Sub
Here you can see Autofilter in action :)
To call the above code by clicking Range A1, you can use the Worksheet_BeforeDoubleClick event.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1")) Is Nothing Then
'
'~~> Your code goes here
'
Cancel = True
End If
End Sub
Regarding your query about making Range A1 respond as an ON/OFF switch, you can use a boolean variable s shown HERE