Private Sub ComboBox8_Change()
Dim vRow As Double
Dim rPICRange As Range
Dim rComRange As Range
Set rComRange = dbComWB.Worksheets("CustomerList").Range("B2")
Set rComRange = Range(rComRange, rComRange.End(xlDown))
vRow = Application.WorksheetFunction.Match(Me.ComboBox8.value, rComRange, 0)
Set rPICRange = dbComWB.Worksheets("CustomerList").Range(Cells(vRow + 1, 14).Address)
Set rPICRange = Range(rPICRange, rPICRange.End(xlToRIght))
Me.ComboBox9.RowSource = rPICRange.Address(external:=True)
End Sub
Above are my code that want to fill a combobox but the "rPICRange" set to Rowsource as a single range instead of a list.
I do tried printout individual value of "rPICRange" & "rPICRange.end(xlToRight)" before assign to RowSource, it is correct value i want.
I also debug by changing .End(xlToRight) to other direction. Seen to me .End(xlUp) & .End(xlDown) work fine but Right & left is mess up.
Edit:
Is that because of ComboBox.RowSource only accept range in row (xlIp/xlDown), but not range in column (xlToRight/xlToLeft). If yes, how can i "Transpose" the range?
Set rPICRange = Application.WorksheetFunction.Transpose(Range(Cells(vRow + 1, 14).Address, rPICRange.End(xlToRight)))
Code above not working for me.
You cannot use Range without a parent worksheet reference even if you are defining it with range objects that have parent worksheet objects in a private sub or any sub in a worksheet code page. See Is the . in .Range necessary when defined by .Cells? for an extended discussion on this.
Option Explicit
Private Sub ComboBox8_Change()
Dim vRow As Double
Dim rPICRange As Range
Dim rComRange As Range
With dbComWB.Worksheets("CustomerList")
Set rComRange = .Range("B2")
Set rComRange = .Range(rComRange, rComRange.End(xlDown))
End With
vRow = Application.WorksheetFunction.Match(Me.ComboBox8.Value, rComRange, 0)
With dbComWB.Worksheets("CustomerList")
Set rPICRange = .Cells(vRow + 1, 14)
Set rPICRange = .Range(rPICRange, rPICRange.End(xlToRight))
End With
Me.ComboBox9.RowSource = rPICRange.Address(external:=True)
End Sub
I'm not entirely sure what you were trying to accomplish with the Range.Address property but I believe I've rectified it.
Private Sub ComboBox8_Change()
Dim vRow As Double
Dim Rng As Range
Dim rPICRange As Range
Dim rComRange As Range
Set rComRange = dbComWB.Worksheets("CustomerList").Range("B2")
Set rComRange = Range(rComRange, rComRange.End(xlDown))
Me.ComboBox9.Clear
vRow = Application.WorksheetFunction.Match(Me.ComboBox8.value, rComRange, 0)
Set rPICRange = dbComWB.Worksheets("CustomerList").Range(Cells(vRow + 1, 14).Address)
Set rPICRange = Range(rPICRange, rPICRange.End(xlToRight))
'code below add each range value into the list
For Each Rng In rPICRange
Me.ComboBox9.AddItem Rng.value
Next Rng
End Sub
Thank to YowE3K. I finally manage to get it working.
Lesson Learned:
RowSource indeed for Row range only, when input Column range will only get the first data.
Related
I have a fairly simple request in Excel using VBA, but I can't think of a way to do it, and I can't find any solutions online.
I have selected multiple columns, and I want to use a macro to expand the selection either side of each selected column.
So for instance I have highlighted columns G, K and Z, and I want to be able to have highlighted F-H, J-L, and Y-AA.
Hope that makes sense, many thanks!
I'm not supposed to answer questions that don't have code examples but this question is impossible to solve without a lot of experience working with ranges.
Outer Loop (Area): Iterate through each Area in Selection.Areas
Inner Loop (Item): Iterate all the Column references
Create a New Range that references the `Area.EntireRow.Columns(Item)
If the Target is Nothing: Set Target = NewRange
Else Set Target = Union(Target, NewRange )
Demo
Sub TestExpandRange()
Application.Goto ExpandRange(Selection, "H", "J:L", "Y:AA")
End Sub
Function ExpandRange(Source As Range, ParamArray ColumnArgs() As Variant) As Range
Dim Target As Range
Dim NewRange As Range
Dim Area As Range
Dim Item As Variant
For Each Area In Source.Areas
For Each Item In ColumnArgs
Set NewRange = Area.EntireRow.Columns(Item)
If Target Is Nothing Then
Set Target = NewRange
Else
Set Target = Union(Target, NewRange)
End If
Next
Next
Set ExpandRange = Target
End Function
Edit 1
This will add the extra columns to the Selection
Function ExpandRange2(Source As Range, ParamArray ColumnArgs() As Variant) As Range
Dim Target As Range
Dim NewRange As Range
Dim Area As Range
Dim Item As Variant
Set Target = Source
For Each Area In Source.Areas
For Each Item In ColumnArgs
Set NewRange = Area.EntireRow.Columns(Item)
Set Target = Union(Target, NewRange)
Next
Next
Set ExpandRange2 = Target
End Function
Edit 2
Sub SelectAdjacentColumns()
Dim Target As Range
Dim NewRange As Range
Dim Area As Range
For Each Area In Selection.Areas
If Area.Column = 1 Then
Set NewRange = Area.Resize(, 2).EntireColumn
ElseIf Area.Column = Columns.Count Then
Set NewRange = Area.Offset(, -1).Resize(, 2).EntireColumn
Else
Set NewRange = Area.Offset(, -1).Resize(, 3).EntireColumn
End If
If Target Is Nothing Then
Set Target = NewRange
Else
Set Target = Union(Target, NewRange)
End If
Next
Target.Select
End Sub
I have A1 =1 which is the number of tables. If the value in the cell changes - a new table is added. I have a macro that searches it (code below). How can I make it search the range if I know that:
distances between each table are constant (5 empty cells)
table currently has fixed value (but will change in future)
i know number of tables
I am looking for a way that, for each next table (A1), the range of searching it, will change to this added one.
I would especially ask for help with setting up .Range.
The mentioned code:
Sub pulling_row_number_if_it_finds_the_code_in_the_table()
Dim my_cell As Object
Dim nr_row_code_found As Integer
Dim my_Range As Range
With Worksheets("Sheet1")
Set my_Range = Range("A5:A50")
For Each my_cell In my_Range
If my_cell.Value = .Range("B1").Value Then
nr_row_code_found = my_cell.Row
.Range("F1") = nr_ row_code_found
End If
Next my_cell
End With
End Sub
If the tables are all the same size:
Sub pulling_row_number_if_it_finds_the_code_in_the_table()
Dim my_Range As Range, m, tblNum As Long
Dim rngT1 As Range
With Worksheets("Sheet1")
Set rngT1 = .Range("A5:A50") 'first table
tblNum = .Range("A1").Value
Set my_Range = rngT1.Offset((tblNum - 1) * (rngT1.Rows.Count + 5))
m = Application.Match(.Range("B1").Value, my_Range, 0)
If Not IsError(m) Then 'if got a match
.Range("F1") = my_Range.Cells(m).Row
Else
.Range("F1") = "no match"
End If
End With
End Sub
I've been trying to look this up everywhere and I can't seem to find the answer or get it to work.
I have the code
'Define Variables for cell ranges'
Dim BidItem As Range
Dim BidItemDes As Range
Dim BidItemUnit As Range
Dim BidItemQTY As Range
Dim BidItemUP As Range
'Store the sheet range into the variables'
Set BidItem = Sheets("BidItems").Range("A1:A" & Range("A1").End(xlDown).Row)
Set BidItemDes = Sheets("BidItems").Range("B1:B" & Range("B1").End(xlDown).Row)
Set BidItemUnit = Sheets("BidItems").Range("C1:C" & Range("C1").End(xlDown).Row)
Set BidItemQTY = Sheets("BidItems").Range("D1:D" & Range("D1").End(xlDown).Row)
Set BidItemUP = Sheets("BidItems").Range("E1:E" & Range("E1").End(xlDown).Row)
Set BidItemValue = Sheets("BidItems").Range("F1:F" & Range("F1").End(xlDown).Row)
Set BidItemValue = Sheets("BidItems").Range("F1:F" & Range("F1").End(xlDown).Row)
What I need to do is have all the data in range BidItemQTY and Multiply it by the range BidItemUP
and then output that answer to the range BidItemValue.
I have the last line of code setup to start the function but
I can't seem to grasp on how to do math functions in VBA with Variables.
Consider this tiny example:
Sub dural()
Dim second As Range
Dim first As Range, prodt As Long
Set first = Range("A1:A3")
Set second = Range("B1:B3")
prodt = Application.WorksheetFunction.SumProduct(first, second)
MsgBox prodt
End Sub
EDIT#1:
To get the individual products stored in cells, use:
Sub dural()
Dim second As Range
Dim first As Range, prodt As Long
Dim third As Range
Set first = Range("A1:A3")
Set second = Range("B1:B3")
Set third = Range("C1:C3")
For i = 1 To 3
third(i, 1) = first(i, 1) * second(i, 1)
Next i
End Sub
Notes:
since the ranges are not single cells, we treat them as two-dimensional
it may be possible to avoid the loop using Transpose()
in this case the one-dimensional will also work:
For i = 1 To 3
third(i) = first(i) * second(i)
Next i
I am trying to get the values of the visible cells of a range into an array.
My code makes the array carry the values until the first non visible cell then stops.
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
ListeMaschinen = Auswahl
End Function
If I select the range it shows all the cells I want marked.
Auswahl.Select
Here I have added the range cells to an array.
Sub examp()
Dim rng As Range, cll As Range, i As Integer, a(100) As Variant
Set rng = Range(Range("A2:B2"), Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
i = 0
For Each cll In rng
a(i) = cll.Value
i = i + 1
Next
End Sub
In your code, you are setting a Variant variable equal to a Range object without using the Set statement.
The following works with the little testing I did. Of course, if you declare the function type and other variables as Range type, it also works.
Option Explicit
Sub test()
Dim myVar As Variant
Set myVar = myList()
Debug.Print myVar.Address
End Sub
Public Function myList() As Variant
Dim myRng As Range
With Sheets("Sheet1")
Set myRng = .Range(.Range("A1:B1"), .Range("A1:B1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
Debug.Print myRng.Address
Set myList = myRng
End Function
I think your issue is related to
.SpecialCells(xlCellTypeVisible)
When I do this:
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
'Auswahl.Select
End Function
I get an Address composed of 2 parts: the visible parts!
But when I remove the SpecialCells
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown))
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
End Function
I get one single part, which Is what I get when using Select too.
I tested!
Sub test()
Dim myVar As Variant
Dim i As Integer
i = 0
Set myVar = ListeMaschinen()
For Each C In myVar
i = i + 1
MsgBox C.Value & C.Address & "-" & i
Next
End Sub
Further to my comments earlier, here is a method that will work subject to some limitations:
You can't have more than 65536 rows of data; and
You can't have really long text (911 chars+), or blank visible cells; and
The data should not contain the string "|~|"
If those conditions are met, you can use something like this:
Dim v
Dim sFormula As String
With Selection
sFormula = "IF(SUBTOTAL(103,OFFSET(" & .Cells(1).Address(0, 0) & ",row(" & .Address(0, 0) & ")-min(row(" & .Address(0, 0) & ")),1))," & .Address(0, 0) & ",""|~|"")"
End With
Debug.Print sFormula
v = Filter(Application.Transpose(Evaluate(sFormula)), "|~|", False)
You can adapt this to work round the third limitation by changing the alternate text in the formula string.
Hello :) I was trying to find a way to loop through visible rows in a table without going through all the rows and checking if they are visible as this was consuming too much time on a large table. Below is the solution I was able to come up with. It is a function that returns an array of the absolute row numbers of visible rows in a given Range.
Function GetVisibleRows(LookupRange As Range) As Integer()
Dim VisibleRange As Range, Index As Integer, Area As Range
Static VisibleRows() As Integer
Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)
ReDim VisibleRows(0)
Index = 0
For Each Area In VisibleRange.Areas
If Index = 0 Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Index = UBound(VisibleRows())
If VisibleRows(Index - 1) <> Area.Row Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Next
' Remove last empty item
ReDim Preserve VisibleRows(UBound(VisibleRows()) - 1)
GetVisibleRows = VisibleRows
End Function
If you would like to use this function in a lookup scenario, you need to convert the absolute row numbers returned by the function to relative row numbers of the table. Following worked for me.
RowIndex = ReturnedRowIndex - LookupRange.Rows(1).Row + 1
Good luck!
I want to give a range instead of offset in the following code. following code copies the color from range(C5:F11) to the offset i set but i want to specify a range like range(M5:P11). I tried it simply replacing offset by range but it does not work properly. Please help
Sub MatchColors2()
For Each myCellColor In Range("C5:F11")
myCellColor.Offset(0, 8).Interior.ColorIndex = myCellColor.Interior.ColorIndex
Next
End Sub
Thanks
Along with your requirement, this also works for ranges with more than one Area, i.e., non-contiguous ranges:
Sub MatchColors2()
Dim rngTo As Excel.Range
Dim rngFrom As Excel.Range
Dim i As Long
Dim j As Long
Set rngTo = ActiveSheet.Range("C5:D11,F5:G11")
Set rngFrom = ActiveSheet.Range("I5:J11,L5:M11")
For i = 1 To rngFrom.Areas.Count
For j = 1 To rngFrom.Areas(i).Cells.Count
rngTo.Areas(i).Cells(j).Interior.ColorIndex = rngFrom.Areas(i).Cells(j).Interior.ColorIndex
Next j
Next i
End Sub