I want to define and copy a range of cells based on the value contained within a cell.
If cell W2 contains the entry "B6:B12", then the code will select that range and copy the contents into Column X
Sub RangeSel()
Dim rng As Range
Dim Sel As String
Sel = Range("W2").Value
Set rng = Range("Sel").Copy(Range(Range("X2"), Range("X2").End(xlDown)))
End Sub
Your description is a bit enigmatic. Something like that?
Sub RangeSel()
Dim rng As Range
Dim Sel As String
Sel = Range("W2").Value
Set rng = Range(Sel)
rng.Copy
Range(Range("X2"), Range("X2").End(xlDown)).PasteSpecial xlPasteAll
End Sub
Is this what you are looking for?
Sub RangeSel()
Dim rng As Range
Dim Sel As String
Sel = Range("W2").Value
Set rng = Range(Sel)
rng.Copy
Range("X2").PasteSpecial
End Sub
You tried to set a range and copy at the same time, does not work
If you want to Copy >> Paste (not using PasteSpecial) then you can do it with 1 line of code, see below :
Sub RangeSel()
Dim rng As Range
Dim Sel As String
Sel = Range("W2").Value
Set rng = Range(Sel)
' optional : make sure there is a valid range
If Not rng Is Nothing Then
rng.Copy Destination:=Range("X2") ' copy>>paste in 1 line, paste at column X second row
End If
End Sub
Related
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
I managed to get this code:
Sub ColorChange()
Dim ws As Worksheet
Set ws = Worksheets(2)
clrOrange = 39423
clrWhite = RGB(255, 255, 255)
If ws.Range("D19").Value = "1" And ws.Range("E19").Value = "1" Then
ws.Range("D19", "E19").Interior.Color = clrOrange
ElseIf ws.Range("D19").Value = "0" Or ws.Range("E19").Value = "0" Then
ws.Range("D19", "E19").Interior.Color = clrWhite
End If
End Sub
This works, but now I need this code to work in 50 rows and 314 cells, but every time only on two cells so, D19+E19, D20+E20, etc. Endpoint is DB314+DC314.
Is there a way, without needing to copy paste this code and replacing all the row and cells by hand?
It also would be nice that if the value in the two cells is anything other than 1+1 the cell color changes back to white.
EDIT: The solution thanks to #VBasic2008.
I added the following to the sheet's code to get the solution to work automatically:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D19:DC314")) Is Nothing Then
Call ColorChange
End If
End Sub
And because Interior.Color removes borders I added the following sub:
Sub vba_borders()
Dim iRange As Range
Dim iCells As Range
Set iRange = Range("D19:DC67,D70:DC86,D89:DC124,D127:DC176,D179:DC212,D215:DC252,D255:DC291,D294:DC314")
For Each iCells In iRange
iCells.BorderAround _
LineStyle:=xlContinuous, _
Weight:=xlThin
Next iCells
End Sub
The Range is a bit different to exclude some rows.
Compare Values in the Two Cells of Column Pairs
Option Explicit
Sub ColorChange()
Const rgAddress As String = "D19:DC314"
Const Orange As Long = 39423
Const White As Long = 16777215
Dim wb As Workbook ' (Source) Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim rg As Range ' (Source) Range
Set rg = wb.Worksheets(2).Range(rgAddress) ' Rather use tab name ("Sheet2").
Dim cCount As Long ' Columns Count
cCount = rg.Columns.Count
Dim brg As Range ' Built Range
Dim rrg As Range ' Row Range
Dim crg As Range ' Two-Cell Range
Dim j As Long ' (Source)/Row Range Columns Counter
For Each rrg In rg.Rows
For j = 2 To cCount Step 2
Set crg = rrg.Cells(j - 1).Resize(, 2)
If crg.Cells(1).Value = 1 And crg.Cells(2).Value = 1 Then
If brg Is Nothing Then
Set brg = crg
Else
Set brg = Union(brg, crg)
End If
End If
Next j
Next rrg
Application.ScreenUpdating = False
rg.Interior.Color = White
If Not brg Is Nothing Then
brg.Interior.Color = Orange
End If
Application.ScreenUpdating = True
End Sub
I am creating simple hyperlink for a range of values as they are in text in original template. The hyperlink part is not working and also wondering the foreach case. I want the original text also to be seen as a hyperlink value in the cell. How do you do this in VBA?
Also how do you do the if statement if you want put it as the if contains pattern like "http://"?
The following does not work and I get errors.
Sub Convert_To_Hyperlinks()
Dim Cell As Range
Dim rng As Range
Dim ws1 As Worksheet
Set rng = Range("E5:E10")
Set ws1 = Sheets("Sheet1")
For Each Cell In rng
If Cell <> "" Then
ws1.Hyperlinks.Add Anchor:=ws1.Cell, Address:=ws1.Cell.Value, ScreenTip:="", TextToDisplay:=ws1.Cell
End If
Next Cell
End Sub
You can use the Like operator:
Sub Convert_To_Hyperlinks()
Dim ws1 As Worksheet, rng As Range, cell As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set rng = ws1.Range("E5:E10")
For Each cell In rng
If cell.Value Like "http://*" Then
ws1.Hyperlinks.Add Anchor:=cell, Address:=cell.Value, TextToDisplay:=cell.Value
End If
Next cell
End Sub
I have written the following code to create worksheet with names same as the names in first column of Sheet1
I am getting a TypeError when trying to set the name on the new worksheet but don't know why. Can someone help?
Sub CreateWorkSheets()
'
' Macro5 Macro
'
'
Dim r As Range
Set r = Sheets("Sheet1").Columns(1)
For Each cell In r
Dim aa As String
Dim newSheet As Worksheet
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
strTemp = cell.Value
newSheet.Name = strTemp // Error Here
Next cell
End Sub
I tried the following code as well and that doesn't work either even though strValue is valid
Sub Test1()
Sheets("Sheet1").Select
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("A2", Range("A2").End(xlDown)).rows.Count
' Select cell a1.
Range("A2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
Dim newSheet As Worksheet
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets("Sheet1").Range("B1").Value = "A" + Trim(Str(x))
strValue = "A" + Trim(Str(x))
newSheet.Name = Str(Sheets("Sheet1").Range(strValue).Value)
Next
End Sub
Apparently because you set:
Set r = Sheets("Sheet1").Columns(1)
It set the cell object to column $A:$A instead of $A$1 like you would think. I put this in the immediate window when I ran into the "cell.value" line:
?cell.Address
$A:$A
You should avoid using an entire column to do what you're trying to do and I would highly recommend you add these keywords to the top of your module:
Option Explicit
This will check your code a little more thoroughly and help you avoid unwanted errors.
To fix this, you can get the exact range you need and I recommend you declare every variable so it stays a specific type.
Something like this:
Option Explicit
Sub CreateWorkSheets()
Dim r As Range
Dim sh As Worksheet
Dim tempSh As Worksheet
Dim cell As Range
Dim strTemp As String
Set sh = Sheets("Sheet1")
Set r = sh.Range(sh.Cells(1, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp))
For Each cell In r
Set tempSh = Sheets.Add(After:=Sheets(Sheets.Count))
strTemp = cell.Value
tempSh.Name = strTemp '// no more error
Next cell
End Sub
I am trying to write code that will loop through all cells in a range. Eventually I want to do something more complicated, but since I was having trouble I decided to create some short test programs. The first example works fine but the second (with a named range) doesn't (gives a "Method Range of Object_Global Failed" error message). Any ideas as to what I'm doing wrong? I'd really like to do this with a named range... Thanks!
Works:
Sub foreachtest()
Dim c As Range
For Each c In Range("A1:A3")
MsgBox (c.Address)
Next
End Sub
Doesn't work:
Sub foreachtest2()
Dim c As Range
Dim Rng As Range
Set Rng = Range("A1:A3")
For Each c In Range("Rng")
MsgBox (c.Address)
Next
End Sub
Set Rng =Range("A1:A3") is creating a range object, not a named range. This should work
Sub foreachtest2()
Dim c As Range
Dim Rng As Range
Set Rng = Range("A1:A3")
For Each c In rng
MsgBox (c.Address)
Next
End Sub
If you want to create a Named Range called Rng then
Range("A1:A3).Name="Rng"
will create it or you can create and loop it like thsi
Dim c As Range
Range("a1:a3").Name = "rng"
For Each c In Names("rng").RefersToRange
MsgBox c.Address
Next c
To adjust your second code, you need to recognize that your range rng is now a variable representing a range and treat it as such:
Sub foreachtest2()
Dim c As Range
Dim Rng As Range
Set Rng = Range("A1:A3")
For Each c In rng
MsgBox (c.Address)
Next
End Sub
Warning: most of the time, your code will be faster if you can avoid looping through the range.
Try this, instead:
Sub foreachtest2()
Dim c As Range
Range("A1:A3").Name = "Rng"
For Each c In Range("Rng")
MsgBox (c.Address)
Next
End Sub