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
Related
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
I'd like to merge identical adjacent cells within a column. Some online examples loop through the column and merge every time the cell below matches, and I'd like to avoid that. Here's my current broken attempt that spits out run-time error 5.
Sub Merge2()
Application.ScreenUpdating = False
Dim rng1 As Range
Dim rng2 As Range
Dim certaincell As Range
Dim LastRow As Long
LastRow = 0
LastRow = Cells(Rows.Count, 35).End(xlUp).Row
Set rng1 = Range(Cells(2, 35), Cells(LastRow, 35))
CheckUnder:
For Each certaincell In rng1
Set rng2 = Union(rng2, certaincell) 'Add the checking cell to the range
If certaincell.Value = certaincell.Offset(1, 0).Value Then 'if the cell is the same as the cell under
'move on to next cell
Else
rng2.Merge 'merge similar cells above
Set rng2 = Nothing
End If
Next
Application.ScreenUpdating = True
End Sub
The variable rng2 is initially set to Nothing. So, adjust your code as follows:
For Each certaincell In rng1
If rng2 Is Nothing Then
Set rng2 = certaincell
End If
Set rng2 = Union(rng2, certaincell) 'Add the checking cell to the range
If certaincell.Value = certaincell.Offset(1, 0).Value Then
Else
rng2.Merge 'merge similar cells above
Set rng2 = Nothing
End If
Next
The if statement will check if the rng2 is nothing and if so, it will assign the currently checked certaincell to the variable.
Also, merging cells with data will pop up some error dialogs. This can be avoided by using Application.DisplayAlerts = False.
Make sure to turn it on using Application.DisplayAlerts = True at the end.
I am trying to write vba code which looks for the term "drek" in column BI. If the term is present in the cell it will then offset (0,1) the value "1".
I have used the code below, however it will only find and offset the first "drek" and then stop. I need it so it will do this with every "drek" it finds.
How might I do this?
Sub find_drek()
Dim rng As Range
Dim cl As Range
Dim sFind As String
sFind = "drek"
Set rng = Range("BI2", Range("BI65536").End(xlUp))
Set cl = rng.find(sFind, LookIn:=xlValues)
If Not cl Is Nothing Then cl.Offset(0, 1).Value = "1"
End Sub
You can try this:
Dim rng As Range
Dim sFind As String
sFind = "drek"
For Each rng In Range("BI2", Range("BI65536").End(xlUp))
If Not rng.Find(sFind, LookIn:=xlValues) Is Nothing Then
rng.Offset(0, 1).Value = "1"
End If
Next rng
Thus, you don't need another range object.
I know "dd.mm.yyyy" is not formatted as date within Excel, and this conversion part is what is getting to me. I have "31.3.2019" within .cell("C5") and want it to convert within the same cell (replace it) with a new formatting of "3/31/2019". I keep on getting an 'out of range' error and I am not sure where my mistake is.
Below is what I have tried:
Sub DivestitureTemplate_ChangeDateFormat()
Application.ScreenUpdating = False
Dim rng As Range
Dim str() As String
Set rng = Range("C5:C3000")
With Worksheets("Divestiture Template")
For Each rng In Selection
str = Split(rng.Value, ".")
rng.Value = DateSerial(2000 + str(4), str(2), str(0))
Next rng
Selection.NumberFormat = "mm/dd/yyyy"
Application.ScreenUpdating = True
End With
End Sub
Change format of ("C5:C3000") from 31.3.2019 to 3/31/2019 -- it can be continuous, but starting at "C5" as this is an automated report and this is below a specified header. I think I have been looking at this, scripting all day and loosing my head over this for no reason.
To get real dates in the column, try:
Sub DivestitureTemplate_ChangeDateFormat()
Dim cell As Range, rng As Range, d As Date
Set rng = Worksheets("Divestiture Template").Range("C5:C3000")
For Each cell In rng
With cell
arr = Split(.Text, ".")
.Value = DateSerial(arr(2), arr(1), arr(0))
.NumberFormat = "m/dd/yyyy"
End With
Next cell
End Sub
EDIT#1:
Sub DivestitureTemplate_ChangeDateFormat()
Dim cell As Range, rng As Range, d As Date
Dim arr
Set rng = Worksheets("Divestiture Template").Range("C5:C3000")
For Each cell In rng
With cell
arr = Split(.Text, ".")
.Value = DateSerial(arr(2), arr(1), arr(0))
.NumberFormat = "m/dd/yyyy"
End With
Next cell
End Sub
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)