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
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 want to copy all filled cells starting from C5 to column F of a different worksheet.
I referred to another post: Excel - Combine multiple columns into one column
Modified the code based on my needs.
Sub CombineColumns()
Dim Range1 As Range, iCol As Long, Range2 As Range, Check As Range, wks As Worksheets
Set Range1 = wks("T(M)").Range(Cells(5, 3), Cells(Cells(5, 3).End(xlDown).Row, Cells(5, 3).End(xlToRight).Column))
Set Check = wks("csv").Range("F1")
If IsEmpty(Check.Value) = True Then
Set Range2 = Check
Else
LastRow = wks("csv").Range("F" & Rows.Count).End(xlUp).Row
Set Range2 = wks("csv").Cells(LastRow, 6).Offset(1, 0)
End If
For iCol = 3 To Range1.Columns.Count
wks("T(M)").Range(Cells(5, iCol), Cells(Range1.Columns(iCol).Rows.Count, iCol)).Copy
wks("csv").Range2.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next iCol
End Sub
But I kept getting the error message
"object doesn't support this method or property"
at the step of pasting. After I tried to qualify all the ranges, It says I didn't set the object variable.
Thank you so much for the help!
How about this?
Sub Transposes()
' Example just for hardcoded data
Dim inputRange As Range
Set inputRange = Sheets("Sheet1").Range("C5:F10").SpecialCells(xlCellTypeConstants)
Dim outputCell As Range
Set outputCell = Sheets("Sheet2").Range("A1")
Dim cell As Range
For Each cell In inputRange
Dim offset As Long
outputCell.offset(offset).Value = cell.Value
offset = offset + 1
Next cell
End Sub
Set the last row in ColumnF to be whatever you want, and if that changes dynamically, just use any one of the multiple techniques out there to find the last cell you need to copy/paste.
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.
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'm trying to copy masses of information from one spreadsheet to another to make it easier to print out on one piece of paper. All the data is set out in sequence and in columns and they need to be printed as such.
I'm trying to create a userform to speed this up by copying different column ranges and pasting them in to another spreadsheet in the exact same format but in columns of 50 cells and a maximum of 4 columns per sheet of paper.
This is what I've got so far, but it only copies the first cell:
Private Sub UserForm_Click()
UserForm1.RefEdit1.Text = Selection.Address
End Sub
Private Sub CommandButton1_Click()
Dim addr As String, rng
Dim tgtWb As Workbook
Dim tgtWs As Worksheet
Dim icol As Long
Dim irow As Long
Set tgtWb = ThisWorkbook
Set tgtWs = tgtWb.Sheets("Sheet1")
addr = RefEdit1.Value
Set rng = Range(addr)
icol = tgtWs.Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Column
tgtWs.Cells(1, icol).Value = rng.Value
End Sub
Any help would be greatly appreciated.
Your approach for outputting the data is only referencing a single cell. You use .Cells(1,icol) which will only reference a single cell (in row 1, and a single column).
In order to output the data to a larger range, you need to reference a larger range. The easiest way to do this is probably via Resize() using the size of the RefEdit range.
I believe this will work for you. I changed the last line to include a call to Resize.
Private Sub CommandButton1_Click()
Dim addr As String, rng
Dim tgtWb As Workbook
Dim tgtWs As Worksheet
Dim icol As Long
Dim irow As Long
Set tgtWb = ThisWorkbook
Set tgtWs = tgtWb.Sheets("Sheet1")
addr = RefEdit1.Value
Set rng = Range(addr)
icol = tgtWs.Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Column
tgtWs.Cells(1, icol).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End Sub
Edit: I went ahead and created a dummy example to test this out:
Click the button and it pastes