How to create a range from two ranges in VBA? - excel

I have two ranges, each containing a single cell (for example "A1" and "C3").
How do I get a new range containing all the cells between these two ("A1:C3")?
I tried this:
Set NewRange = Range(Range1.Address:Range2.Address)
Also how do I set a range in R1C1 format? I want to use something like Range("R1C2") instead of Range("A2").

Like this?
Sub Sample()
Dim rng1 As Range, rng2 As Range
Dim NewRng As Range
With ThisWorkbook.Sheets("Sheet1")
Set rng1 = .Range("A1")
Set rng2 = .Range("C3")
Set NewRng = .Range(rng1.Address & ":" & rng2.Address)
Debug.Print NewRng.Address
End With
End Sub
Instead of R1C1 format use Cells(r,c). That will give you more flexibility + control
So Range("A2") can be written as Cells(2,1)

You can set the a new range in various ways. Below are a few examples. To get R1C1 format - I personally find it easier entering the normal formula and then using VBA to extract the R1C1 format required. See the debug.print statements below.
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Dim newRng As Range
With Sheet1
Set rng1 = .Range("A1")
Set rng2 = .Range("C3")
Debug.Print rng1.FormulaR1C1
Debug.Print rng1.FormulaR1C1Local
'Method1
Set newRng = .Range(rng1, rng2)
'method2
Set newRng = .Range(rng1.Address, rng2.Address)
'method3 (Only works if rng1 & rng2 are single cells
Set newRng = .Range(rng1.Address & ":" & rng2.Address)
'method4
Set newRng = Union(rng1, rng2)
End With
End Sub

Method 4 is not the same as Method 1 when the ranges are not adjacent.
With Sheet1
Set rng1 = .Range("A1:A3")
Set rng2 = .Range("C1:C3")
'This combines the two separate ranges, so select A1, A2, A3, C1, C2, C3
set newRng = Union(rng1, rng2)
'This combines the two ranges in the same way as when using "A1:C3",
'so including the cells from column B
set newRng = .Range(rng1, rng2)

It´s also possible something like:
Dim newRange as Range
Set newRange = Range("A1:A4,A7:A9,C1:D9") 'Three different regions grouped
'or
Set newRange = Range("A1:A4,A7:A9,C1:D9, D10:D11") 'Four different regions grouped.
'or
Set newRange = Range("A1:A4,A7:A9,C1:D9, D10:D11, ...") 'N different regions grouped.

Put this in a module:
Private Function CombineRanges(rng1 As Range, rng2 As Range) As Range
Set CombineRanges = ActiveSheet.Range(rng1.Address & ":" & rng2.Address)
End Function
Use it like:
Dim NewRange As Range
Set NewRange = CombineRanges(Range1, Range2)

Related

Exclude specific row in the range

I want to exclude A2:B2 from A1:B5 and store it as a range so that I can use it later. I have the code below which does not return error but does not seem to store anything in the range.
Sub ExcludeRange()
Dim rng As Range
Dim newRng As Range
Set rng = Sheets("Sheet1").Range("A1:B5") 'set the range you want to work with
Set newRng = rng.Offset(2, 0).Resize(rng.Rows.Count - 1, _
rng.Columns.Count)
Sheets("Sheet1").Range("C1").Value = newRng
End Sub
I want to exclude A2:B2 from A1:B5
then simply go Set newRng = Range("A1:B1, A3:B5")
Sheets("Sheet1").Range("C1").Value = newRng
you seem to want to paste a (possible) discontinuous range to a "continuous" one given its upper right cell
you have to loop through Areas property of a Range object in order to handle all the "sub-Ranges" it's made of
like follows:
Sub CopyRangeValue(rangeToPaste As Range, targetCel As Range)
With targetCel 'reference the upper-right cel of the pasted range
Dim rowOffset As Long
rowOffset = 0
Dim area As Range
For Each area In rangeToPaste.Areas ' loop through all the "sub-Ranges" the range to paste is made of
.Offset(rowOffset).Resize(area.Rows.Count, area.Columns.Count).Value = area.Value ' paste the current continuous "sub-Range" to the proper target cell
rowOffset = rowOffset + area.Rows.Count ' update the paste offset from the target cel
Next
End With
End Sub
Sub ExcludeRange()
Dim newRng As Range
With Sheets("Sheet1")
Set newRng = .Range("A1:B1, A3:B5")
CopyRangeValue newRng, .Range("K1")
End With
End Sub

Compare numbers between two columns and match the colours

I am struggling to find any info on the internet to make this work, please help me out.
I would like a function to do the following (summarized below)
As you can see column A3:A7 has a number in each cell and a colour associated with that specific number.
I would like the code to scan through A3:A7 and match the numbers in C3:C7 with the colour that's already applied. (See below for detailed explanation)
For instance, A3 has a value of 1 and is yellow, I would like the code to scan through all numbers in Column C (C3:C7) and identify that C6 is also 1, therefore it will apply yellow to C6.
Initial:
Final:
Also can this be done across two different Sheets.For example lets say A3:A7 is on Sheet1 and I want to find matches in C3:C7 in Sheet2
Sub ColourCells()
Dim Rng1 As Range, Rng2 As Range, Rng2Item As Range
Dim Rng1LRow As Long, Rng2LRow As Long
Dim Rng1Match As Variant
With Worksheets("Sheet1")
Rng2LRow = .Cells(.Rows.Count, 3).End(xlUp).Row
Set Rng2 = .Range("C3:C" & Rng2LRow)
End With
With Worksheets("Sheet2")
Rng1LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng1 = .Range("A3:A" & Rng1LRow)
End With
For Each Rng2Item In Rng2
With Rng2Item
Rng1Match = Application.Match(.Value, Rng1, 0)
If IsError(Rng1Match) Then
GoTo NextItem
Else
.Interior.Color = Application.Index(Rng1, Rng1Match, 0).Interior.Color
End If
End With
NextItem:
Next Rng2Item
End Sub
Sub test()
Dim rng1 As Range, rng2 As Range, rng As Range
Set rng1 = Range("A3:A7")
Set rng2 = Range("C3:C7")
For Each rng In rng2
With Application.WorksheetFunction
If .CountIf(rng1, rng.Value) > 0 Then rng.Interior.Color = .Index(rng1, .Match(rng.Value, rng1, 0), 1).Interior.Color
End With
Next rng
Set rng1 = Nothing
Set rng2 = Nothing
End Sub

How to select entire column except header

I am using below code.
Sub Replace_specific_value()
'declare variables
Dim ws As Worksheet
Dim xcell As Range
Dim Rng As Range
Dim newvalue As Long
Set ws = ActiveSheet
Set Rng = ws.Range("G2:G84449")
'check each cell in a specific range if the criteria is matching and replace it
For Each xcell In Rng
xcell = xcell.Value / 1024 / 1024 / 1024
Next xcell
End Sub
Here i don't want to specify G2:G84449 , how do i tell VBA to pick all value instead of specifying range?
Watch: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)
Here is the standard way to get the used cell in column G starting at G2:
With ws
Set Rng = .Range("G2", .Cells(.Rows.Count, "G").End(xlUp))
End With
If the last row could be hidden use:
With ws
Set Rng = Intersect(.Range("A1", .UsedRange).Columns("G").Offset(1), .UsedRange)
End With
If Not Rng Is Nothing Then
'Do Something
End If
Reference Column Data Range (w/o Headers)
If you know that the table data starts in the first row of column G, by using the Find method, you can use something like the following (of course you can use the more explicit
With ws.Range("G2:G" & ws.Rows.Count) instead, in the first With statement).
Option Explicit
Sub BytesToGigaBytes()
Const Col As String = "G"
Dim ws As Worksheet: Set ws = ActiveSheet 'improve!
With ws.Columns(Col).Resize(ws.Rows.Count - 1).Offset(1) ' "G2:G1048576"
Dim lCell As Range: Set lCell = .Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' empty column
With .Resize(lCell.Row - .Row + 1) ' "G2:Glr"
.Value = ws.Evaluate("IFERROR(IF(ISBLANK(" & .Address & "),""""," _
& .Address & "/1024/1024/1024),"""")")
End With
End With
End Sub
Here's a slightly different approach that works for getting multiple columns, as long as your data ends on the same row:
set rng = application.Intersect(activesheet.usedrange, activesheet.usedrange.offset(1), range("G:G"))
This takes the intersection of the used range (the smallest rectangle that holds all data on the sheet, with the used range offset by one row (to exclude the header), with the columns you are interested in.

take the name of the month in date format

https://i.stack.imgur.com/9aNsi.jpg
I learned VBA from scratch and started simple.
I just want to display the month name from the date format in Column B2: B690, and put it in Column A2: A690 .. but my code has an error.
can you help me find the right solution in coding?
Dim rng1, rng2 As Range
Set rng1 = Range("A2:A690")
Set rng2 = Range("B2:B690")
rng1.Value = WorksheetFunction.Text(rng2, "mmmm")
Try the next code, please:
Dim rng1, rng2 As Range
Set rng2 = Range("B2:B690")
rng2.Copy Range("A2")
Set rng1 = Range("A2:A690")
rng1.NumberFormat = "MMMM"
Or avoiding the use of clipboard:
Sub testTextMonthName()
Dim rng1, rng2 As Range
Set rng1 = Range("A2:A690")
Set rng2 = Range("B2:B690")
With rng1
.Value2 = rng2.Value2
.NumberFormat = "MMMM"
'.value = .Text 'if you need it as text, uncomment this line, please
End With
End Sub

Match a value from the table to a dropdown range

I have been trying this for a while now and am not able to figure out the for code for this problem.
I have a table in sheet1 with two columns, in one column I have positions, in the next I have people who can work on those positions.
In sheet2 I have the list of all the positions and the one that are supposed to be staffed are highlighted when you select a SKU, and two columns besides it is the dropdown list of the employees.
This same sheet also has a range which displays employee who are not working that day.
Tried to implement #BruceWayne answer the code is:
Option Explicit
'use a constant to store the highlight color...
Const HIGHLIGHT_COLOR = 9894500 'RGB(100, 250, 150)
Sub AssignBided()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cel1 As range
Dim cel2 As range
Dim line8 As range
Dim Offemp As range
Dim BidL8 As range
Dim BidL8E As range
Dim coresVal As String
Set ws1 = Worksheets("OT_Table")
Set ws2 = Worksheets("Monday")
Set line8 = ws2.range("Line8_Hilight_Mon")
Set Offemp = ws2.range("Off_Mon")
Set BidL8 = ws1.range("BidedL8")
Set BidL8E = ws1.range("BidedL8_E")
For Each cel2 In BidL8E
For Each cel1 In line8
If IsHighlighted(cel1) Then
If Application.WorksheetFunction.CountIf(Offemp, cel2.Value) > 0 Then
coresVal = Evaluate("Index(" & BidL8E.Address & "),MATCH(" & cel1.Validation & "," & BidL8.Address & ",0))")
Debug.Print coresVal
cel1.Offset(0, 2).Value = coresVal
End If
End If
Next cel1
Next cel2
End Sub
'Is a cell highlighted? EDIT: changed the function name to IsHighlighted
Function IsHighlighted(c As range)
IsHighlighted = (c.Interior.Color = HIGHLIGHT_COLOR)
End Function
This code is giving me this error: Object doesn't support this property or method. It highlights the evaluate line. Am I using this in some wrong manner?
From the comments, I think this is what you are trying to do.
(I renamed some variables to make them a little easier to understand. Also, adjust the named ranges as needed. They may not all be on the "OT_Table" sheet, which I assumed they were. It wasn't clear.)
Sub AssignBided()
Dim ws As Worksheet
Set ws = Worksheets("OT_Table")
Dim cel As Range
Dim line8 As Range
Set line8 = ws.Range("Line8_Highlight_Mon")
Dim Offemp As Range
Set Offemp = ws.Range("Scheduled_Off")
Dim BidL8 As Range
Set BidL8 = ws.Range("BidedL8_T")
Dim coresVal As String
For Each cel In line8
' cel.Select
If IsHighlighted(cel) Then
If Application.WorksheetFunction.CountIf(Offemp, cel.Value) > 0 Then
coresVal = Evaluate("INDEX(OFFSET(" & BidL8.Address & ",,2),MATCH(" & _
cel.Value & "," & BidL8.Address & ",0))")
Debug.Print coresVal
cel.Offset(0, 2).Value = coresVal
End If
End If
Next cel
End Sub

Resources