I have code, which put formula into area and it works fine:
Private Sub Jeeves_account2_C()
Dim lastrow As Long
Dim rng As Range, C As Range
With Worksheets("Crd_Headers") ' <-- here should be the Sheet's name
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row ' last row in column B
Set rng = .Range("C2:C" & lastrow) ' set the dynamic range to be searched
' loop through all cells in column B
For Each C In rng
If Not IsEmpty(C.Value) Then
C.Offset(, -1).Formula = "=IFERROR(VLOOKUP(RC[2],Jeeves_Cust_list!C[-1]:C[1],3,0),RC[2])" ' use offset to put the formula in column "P"
End If
Next C
End With
End Sub
But I would like to add condition, if cell C2 on the sheet Crd_Headers is empty, then skip the whole sub:
If Worksheets("Crd_Headers").Cells("C2") = "" Then
Exit Sub
End If
So the code looks like:
Private Sub Jeeves_account2_C()
If Worksheets("Crd_Headers").Cells("C2") = "" Then
Exit Sub
End If
Dim lastrow As Long
Dim rng As Range, C As Range
With Worksheets("Crd_Headers") ' <-- here should be the Sheet's name
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row ' last row in column B
Set rng = .Range("C2:C" & lastrow) ' set the dynamic range to be searched
' loop through all cells in column B
For Each C In rng
If Not IsEmpty(C.Value) Then
C.Offset(, -1).Formula = "=IFERROR(VLOOKUP(RC[2],Jeeves_Cust_list!C[-1]:C[1],3,0),RC[2])" ' use offset to put the formula in column "P"
End If
Next C
End With
End Sub
But it gives me error message invalid procedure call or argument
Could you advise me, what do I do wrong?
Thank you!
You simply mixed up Cells and Range object references.
To refer single cell you have two solutions:
If Worksheets("Crd_Headers").Range("C2") = "" Then
or
If Worksheets("Crd_Headers").Cells(2, "C") = "" Then
Related
I am working with the excel-vba, I have to sort the rows in ascending order with merged cells, I know that the merged cell cannot be sorted that is why, this work around is the only solution to my problem. I need to unmerged the cells then copy the value of the first cell and paste it to the second cell, after that, the code will sort the list using the A column and C column. and then after that if the A and C column has an equal value, it will turn to merged cell.
I hope someone could help me with this project.
Also view this image to see the list.
Sort
So, I constructed a code that will do this process but it cant.
Sub Sort()
On Error GoTo myErr
Dim myRange As Range
Dim lstrow As Long
Dim i As Integer
Dim cel As Range
Set myRange = Sheet1.Range("A2:C7")
lstrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
With myRange
.UnMerge
For Each cel In myRange
If IsEmpty(cel) Then
For i = 2 To lstrow
' cel(i).Value = 1
Sheet1.Range(i).Copy Sheet1.Range(cel).PasteSpecial
Sheet1.Range("C3").CurrentRegion.Sort _
key1:=Sheet1.Range("C3"), order1:=xlAscending, _
Header:=xlGuess
Next i
End If
Next cel
End With
myErr:
MsgBox "Unble to sort!"
End Sub
“No one is useless in this world who lightens the burdens of another. -Charles Dickens”
Regards,
If you are going to find lstRow before unmerging, use Column B — if the last row in Column A is merged, then the bottommost cell is empty! Or if you prefer, you can find lstRow after unmerging everything.
By looping through myRange you can both UnMerge any merged cells and populate the newly unmerged cells using the MergeArea.address of the original merged cell. After sorting on columns A and C, you can then loop through those columns, comparing each row to the row beneath. Only re-merge when both the row beneath is the same as the row above for both columns.
Option Explicit
Sub Sort()
Dim myRange As Range
Dim lstrow As Long
Dim l As Long
Dim rng As Range
Dim address As String
Dim contents As Variant
Dim ws As Worksheet
On Error GoTo myErr
Set ws = ThisWorkbook.Sheets("Sheet1")
Set myRange = ws.Range("A1:C7")
' Get lstrow from Column B, if Column A has merged cells
lstrow = ws.Cells(Rows.Count, 2).End(xlUp).Row
' Unmerge and populate
For Each rng In myRange
If rng.MergeCells Then
' Get value from top left cell
contents = rng.MergeArea.Cells(1).Value
address = rng.MergeArea.address
rng.UnMerge
ws.Range(address).Value = contents
End If
Next rng
' Sort
myRange.Sort key1:=ws.Range("A1:A" & lstrow), _
order1:=xlAscending, Header:=xlYes, key2:=ws.Range("C1:C" & lstrow), _
order2:=xlAscending, Header:=xlYes
' Turn off alerts
Application.DisplayAlerts = False
' Re-merge
With ws
For l = 2 To lstrow
If .Cells(l, 1).MergeArea.Cells(1).Value = .Cells(l + 1, 1).MergeArea.Cells(1).Value _
And .Cells(l, 3).MergeArea.Cells(1).Value = .Cells(l + 1, 3).MergeArea.Cells(1).Value Then
' Merge column A
Range(.Cells(l, 1).MergeArea, .Cells(l + 1, 1)).Merge
' Merge column C
Range(.Cells(l, 3).MergeArea, .Cells(l + 1, 3)).Merge
End If
Next l
End With
' Turn on alerts
Application.DisplayAlerts = True
Exit Sub
myErr:
MsgBox "Unable to sort!"
End Sub
I've written code to loop through a range for a specific value. If the value equals "123" then highlight the entire row green. However, I only want it to highlight the very first two matches it finds and stop there. Many thanks.
Sub Macro3()
Sheets("XYZ").Select
Dim rng As Range
Sheets("XYZ").Select
Set rng = Range("L2:L10000")
For Each cell In rng
If cell.Value = "123" Then
cell.EntireRow.Interior.ColorIndex = 4
End If
Next
End Sub
It's better if you avoid using Select and other relatives, instead use referenced Objects, Sheets and Ranges.
Also, you can search for the last row with data in Column L instead of just looping through row 10000.
Option Explicit
Sub Macro3()
Dim Rng As Range, cell As Range
Dim counter As Integer, LastRow As Long
With Sheets("XYZ")
' find last row at Column "L"
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
Set Rng = .Range("L2:L" & LastRow)
For Each cell In Rng
If cell.Value = "123" Then
cell.EntireRow.Interior.ColorIndex = 4
counter = counter + 1
End If
If counter >= 2 Then Exit For
Next
End With
End Sub
Sub Macro3()
Sheets("XYZ").Select
Dim rng As Range
dim count as integer
'Set the range in column D to loop through
Sheets("XYZ").Select
Set rng = Range("L2:L10000")
For Each cell In rng
If cell.Value = "123" Then
cell.EntireRow.Interior.ColorIndex = 4
count = count + 1
End If
if count >= 2 Then exit For
Next
End Sub
Filtering lets you avoid looping through cells
Assuming row 1 has header, you can try:
Dim cell As Range
Dim counter As Integer
With Sheets("XYZ")
With .Range("L1", .Cells(.Rows.Count, "L").End(xlUp)) '<--| reference its column "L" cells from row 1 (header) down to last not empty row
.AutoFilter field:=1, Criteria1:="123" '<--| filter referenced range on its first (and only) column with "123"
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell gets filtered
For Each cell In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--| loop through filtered cells, skipping header
cell.EntireRow.Interior.ColorIndex = 4
counter = counter + 1 '<--| update counter
If counter = 2 Then Exit For '<--| exit at 2nd iteration
Next cell
End If
End With
.AutoFilterMode = False
End With
Here's your code with some addition:
Sub Macro3()
Sheets("XYZ").Select
Dim rng As Range
greenrows = 0
Sheets("XYZ").Select
Set rng = Range("b2:b10000")
For Each cell In rng
If cell.Value = "123" Then
If greenrows = 2 Then Exit Sub
cell.EntireRow.Interior.ColorIndex = 4
greenrows = greenrows + 1
End If
Next
End Sub
I am trying to run a macro on 3 different ranges, one after another. Once the range is selected, the code works just fine (where variables F and L are defined). I would like to set r1-r3 as Ranges I need and then use a string variable to concatenate the range numbers together. This code works, but doesn't provide the starting and ending row number in the range selected. This is vital because it tells the "TableCalc" macro when to start and stop the code. I would then like to move on to the next range. Thanks for your help.
Sub TestRangeBC()
WS.Select
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim rngx As String
Dim num As Integer
Dim rng As Range
Set r1 = WS.Range("ONE")
Set r2 = WS.Range("TWO")
Set r3 = WS.Range("THREE")
For num = 1 To 3
rngx = "r" & num
Set rng = Range(rngx)
Dim F As Integer
Dim L As Integer
F = rng.Row + 1
L = rng.Row + rng.Rows.Count - 2
Cells(F, 8).Select
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
'INSERT SITUATIONAL MACRO
Call TableCalc
WS.Select
ActiveCell.Offset(1, 0).Select
Loop
Next num
End Sub
This is not the answer (as part of your code and what you are trying to achieve is unclear yet), but it is a "cleaner" and more efficient way to code what you have in your original post.
Option Explicit
Dim WS As Worksheet
Your original Sub shorten:
Sub TestRangeBC()
' chanhe WS to your Sheet name
Set WS = Sheets("Sheet1")
Call ActiveRange("ONE")
Call ActiveRange("TWO")
Call ActiveRange("THREE")
End Sub
This Sub gets the Name of the Named Range (you set in your workbook) as a String, and sets the Range accordingly.
Sub ActiveRange(RangeName As String)
Dim Rng As Range
Dim F As Integer
Dim L As Integer
Dim lRow As Long
With WS
Set Rng = .Range(RangeName)
' just for debug purpose >> to ensure the right Range was passed and set
Debug.Print Rng.Address
F = Rng.Row + 1
L = Rng.Row + Rng.Rows.Count - 2
lRow = F
' what you are trying to achieve in this loop is beyond me
Do While .Cells(F, 8) <> "" And .Cells(lRow, 8).Row <= L
Debug.Print .Cells(lRow, 8).Address
'INSERT SITUATIONAL MACRO
' Call TableCalc
' not sure you need to select WS sheet again
WS.Select
lRow = lRow + 1
Loop
End With
End Sub
What are you trying to test in the loop below, what are the criteria of staying in the loop ?
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
it's really hard to tell what you may want to do
but may be what follows can help you clarifying and (hopefully) doing it!
first off, you can't "combine" variable names
So I'd go with an array of named ranges names (i.e. String array) to be filled by means of a specific sub:
Function GetRanges() As String()
Dim ranges(1 To 3) As String
ranges(1) = "ONE"
ranges(2) = "TWO"
ranges(3) = "THREE"
GetRanges = ranges
End Function
so that you can clean up your "main" sub code and keep only more relevant code there:
Sub TestRangeBC()
Dim r As Variant
Dim ws As Worksheet
Set ws = Worksheets("Ranges") '<--| change "Ranges" to your actual worksheet name
For Each r In GetRanges() '<--| loop through all ranges names
DoIt ws, CStr(r) '<--| call the range name processing routine passing worksheet and its named range name
Next r
End Sub
the "main" sub loops through the named ranges array directly collected from GetRanges() and calls DoIt() to actually process the current one:
Sub DoIt(ws As Worksheet, rangeName As String)
Dim cell As Range
Dim iRow As Long
With ws.Range(rangeName) '<--| reference the passed name passed worksheet named range
For iRow = .Rows(2).Row To .Rows(.Rows.Count - 2).Row '<--| loop through its "inner" rows (i.e. off 1st and last rows)
Set cell = ws.Cells(iRow, 8) '<--| get current row corresponding cell in column "F"
If cell.value = "" Then Exit For '<--| exit at first blank column "F" corresponding cell
TableCalc cell '<-- call TableCalc passing the 'valid' cell as its parameter
Next iRow
End With
End Sub
I'm writing a macro in Excel 2010 for a problem that is as follows:
I have two columns, one with a Key string value and one with a uuid. The idea is that every key should have only one uuid but as the table is now, key cell could be merged cells or single cells.
The macro needs to recognize which cells are merged and which are not, so, I have two options:
If cell is merged, check all its adjacent cells, pick first uuid value and copy/paste it to other adjacent cells, that is to say, cell below(Could be with an Offset())
If cell is not merged , but key value is repeated in multiple cells, copy/paste uuid value to adjacent cells.
So basically is to check merged cells MergeArea but I don't know if I need to iterate through its addresses or check cells in the range with an offset of Offset(0,1) or what.
With my code I can know if the cells are merged but now, how con I iterate through it's adjacent cells values?
Code as is now:
Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant
Set ws = Sheets(ActiveSheet.Name)
On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
Application.DisplayAlerts = False 'We can cancel the procedure without errors
With ws
lRow = .Range("F" & .Rows.count).End(xlUp).row
Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
rng.Select
For Each cell In rng
If cell.MergeCells Then
'Code for merged cells
Else
'Code to use for single cells
End If
Next cell
End With
ExitProgram:
Exit Sub
End Sub
Option Explicit
Sub CopyUUID()
Const UUID As Long = 31 'col AE
Dim lRow As Long, cel As Range, isM As Boolean, copyID As Boolean, kCol As Long
With ActiveSheet
kCol = -25 'col F
lRow = .Cells(.Rows.Count, UUID + kCol).End(xlUp).Row
For Each cel In .Range(.Cells(3, UUID), .Cells(lRow, UUID))
isM = cel.Offset(0, kCol).MergeCells
copyID = isM And Len(cel.Offset(0, kCol)) = 0
copyID = copyID Or (Not isM And cel.Offset(0, kCol) = cel.Offset(-1, kCol))
If copyID Then cel = cel.Offset(-1)
Next
End With
End Sub
Try the following code. Note that this is going to overwrite the current contents of UUID, so make a backup copy before testing. If you don't want the UUID column modified, you can modify this to suit your needs.
Sub CopyUUID()
Dim lRow As Long
Dim rng As Range
Dim c As Range
Dim ws As Worksheet
Dim rMerged As Range
Dim value As Variant
Set ws = Sheets(ActiveSheet.Name)
On Error GoTo ExitProgram 'If an error happens within the execution, skips it and continue in next step
' Application.DisplayAlerts = False 'We can cancel the procedure without errors
With ws
lRow = .Range("F" & .Rows.Count).End(xlUp).Row
Set rng = .Range(.Cells(3, 6), .Cells(lRow, 6))
' rng.Select
For Each c In rng
If c.MergeCells Then
'Code for merged cells
c.Offset(0, 1).Formula = c.MergeArea.Cells(1, 1).Offset(0, 1).Formula
Else
'Code to use for single cells
If c.Formula = c.Offset(-1, 0).Formula Then
c.Offset(0, 1).Formula = c.Offset(-1, 1).Formula
End If
End If
Next c
End With
ExitProgram:
Exit Sub
End Sub
When in a MergedCell, it makes the UUID the same as the UUID of the first cell in the merged area. When not in a MergedCell, it copies UUID from the row above if Key is the same as the row above.
I changed your variable cell to c (I don't like to use variable names that can be confused with built-ins) and commented out a couple of lines.
Hope this helps
I adopt a simple approach to this problem as illustrated through steps taken by me.
sample sheet showing data with merged cells and unmerged cells.
Run the program code to unmerge the cells. Output of the program is appended below.
If this structure of data matches your case then addition of 2 lines of code for column B will leave the data as per following image.
Program code is as follows:
'Without column deletion:
Sub UnMergeRanges()
Dim cl As Range
Dim rMerged As Range
Dim v As Variant
For Each cl In ActiveSheet.UsedRange
If cl.MergeCells Then
Set rMerged = cl.MergeArea
v = rMerged.Cells(1, 1)
rMerged.MergeCells = False
rMerged = v
End If
Next
End Sub
'With coumn deletion
Sub UnMergeRangesB()
Dim cl As Range
Dim rMerged As Range
Dim v As Variant
For Each cl In ActiveSheet.UsedRange
If cl.MergeCells Then
Set rMerged = cl.MergeArea
v = rMerged.Cells(1, 1)
rMerged.MergeCells = False
rMerged = v
End If
Next
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub
I'm looking for some code that will look at Column A and as long as the cell in Column A is not blank, then the corresponding cell in Column B will equal a specific value.
So if Cell A1 <> "" then Cell B1.Value = "MyText"
And repeat until a cell in Column A is blank or empty.
To add a little more clarification, I have looked through the various loop questions asked and answered here. They were somewhat helpful. However, I'm unclear on how to get the loop to go through Column A to verify that each cell in Column A isn't blank AND in the corresponding cell in Column B, add some text that I specify.
Also, this will need to be part of a VBA macro and not part of a cell formula such as =IF
If you really want a vba solution you can loop through a range like this:
Sub Check()
Dim dat As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A100")
dat = rng
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
rng(i, 2).Value = "My Text"
End If
Next
End Sub
*EDIT*
Instead of using varients you can just loop through the range like this:
Sub Check()
Dim rng As Range
Dim i As Long
'Set the range in column A you want to loop through
Set rng = Range("A1:A100")
For Each cell In rng
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "My Text"
End If
Next
End Sub
Another way (Using Formulas in VBA). I guess this is the shortest VBA code as well?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B1:B" & lRow).Formula = "=If(A1<>"""",""My Text"","""")"
.Range("B1:B" & lRow).Value = .Range("B1:B" & lRow).Value
End With
End Sub
A simpler way to do this would be:
Sub populateB()
For Each Cel in Range("A1:A100")
If Cel.value <> "" Then Cel.Offset(0, 1).value = "Your Text"
Next
End Sub
Use the function IF :
=IF ( logical_test, value_if_true, value_if_false )