I have a problem to count the number of rows for each block of merged cells, in Excel.
I have a value on A1. If I merge cells A1 to A4 the value appears centered, on the range A1-A4.
Then I have another value in A5. If I merge cells A5 to A12, this second value appears centered on this second block of cells.
What I want is to count number of rows for each block of merged cells.
I have tried to use VBA programming to detect these number of rows, with function "MergeArea" and "CurrentRegion.Count" but the program detects that the two blocks are contiguous and counts 12 rows, instead of 4 and then 8.
If it detects "4" first, I could put the correct instruction on a loop and then detect "8".
There are several downsides to merged cells in terms of VBA but here is a simple method to try.
My sheet looks like this:
Code:
Sub CountMergedRows()
For i = 1 To 20
RowCount = Range("A" & i).MergeArea.Rows.Count
If RowCount > 1 Then
MsgBox ("Cell [A" & i & "] has " & RowCount & " merged rows")
i = i + RowCount
End If
Next i
End Sub
Results are two message boxes that appear like this:
Method Range("A" & i).MergeArea.Rows.Count suggested by Portland Runner works fine, however the function has slightly incorrect logic as it is missed that Next also increments i, so it is more correct to write:
Sub CountMergedRows()
For i = 1 To 20
RowCount = Range("A" & i).MergeArea.Rows.Count
If RowCount > 1 Then
MsgBox ("Cell [A" & i & "] has " & RowCount & " merged rows")
i = i + RowCount - 1 'note -1 here
End If
Next i
End Sub
Related
I'm trying to implement a macro that looks for the words "TRUE" and "FALSE" in a huge array of data - and then, when found, changes the color of the cells above it.
Specifically, I would like it to color not the TRUE/FALSE-cell, but the 30 cells directly above it. This is where things get tricky... I hope someone can help.
I've tried adapting the below code, but mostly I'm adding it as inspiration at this point.
Sub ChangeColor()
lRow = Range("C" & Rows.Count).End(xlUp).Row
Set MR = Range("C2:C" & lRow)
For Each cell In MR
Select Case cell.Value
Case "Yes"
cell_colour = 4
Case "y"
cell_colour = 4
Case Else
cell_colour = 3
End Select
cell.Interior.ColorIndex = cell_colour
Next
End Sub
Using a datafield array
Looping through a range is always time consuming; this should speed it up.
Caveat: Formatting single cells can maximize file size, so at least I reformat the whole column C to xlColorIndexNone.
Option Explicit
Public Sub Mark30CellsAbove()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet")
Dim v As Variant
Dim i As Long, j As Long, n As Long, m As Long, r As Long
Dim Rng As Range
Dim t As Double
' stop watch
t = Timer
' get last row in column C
n = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
' get values to one based 2dim array
v = ws.Range("C1:C" & n).Value
' clear existing colors over the WHOLE column to minimize file size
ws.Range("C:C").Interior.ColorIndex = xlColorIndexNone
' loop through C2:Cn and mark 30 rows before found condition
For i = 2 To n
' check condition, find string "true" or "false"
If InStr(".true.false.", "." & LCase(v(i, 1)) & ".") > 0 Then
' set range block - fixed rows count 30 above found cell
If i < 32 Then ' only in case of less than 30 rows
Set rng = ws.Range("C2:C" & (i - 1))
Else
Set rng = ws.Range("C" & (i - 30) & ":C" & (i - 1))
End If
rng.Interior.ColorIndex = 4
End If
Next i
MsgBox "Time needed: " & Format(Timer - t, "0.00") & " seconds."
End Sub
Of course you could also loop within If - EndIf, just to see this slower method:
If InStr(".true.false.", "." & LCase(v(i, 1)) & ".") > 0 Then
' Always avoid to loop through a range
' For j = i - 1 To i - 30 Step -1
' If j < 2 Then Exit For ' optional escape if one line under title row
' ws.Cells(j, 3).Interior.ColorIndex = 4
' Next
End If
The code that I posted should only highlight cells in column B whose value is different from the corresponding cell in column A. I tested it and it worked OK.
If you want to try conditional formatting:
Select column B, or the part of column B that you want to colour conditionally.
In the following, I will assume that B1 is the active cell within the selection.
On the Home tab of the ribbon, click Conditional Formatting > New Rule...
Select "Use a formula to determine which cells to format".
Enter the formula =B1<>A1
If the active cell is not in row 1, adjust the formula accordingly. For example, if the active cell within the selection is B3, use =B3<>A3
Click Format...
Activate the Fill tab.
Select the desired fill colour.
Click OK until all dialogs have closed.
Change some values in column A and/or B to see the result.
Refer - https://social.technet.microsoft.com/Forums/ie/en-US/2fffa4d8-bbba-473b-9346-5fce8f0728a8/using-vba-to-change-a-cell-colour-based-on-the-information-in-a-different-cell-excel-2010?forum=excel
First you need to check whether the row of the cell is higher than 30 and then it you can offset to change the color:
Thus instead of this line: cell.Interior.ColorIndex = cell_colour
write this:
If cell.Row > 30 Then cell.Offset(-30, 0).Interior.ColorIndex = cell_colour
This may be done without VBA. You should set up two conditional formatting with formulas. First:
=COUNTIF(OFFSET(INDIRECT(ADDRESS(ROW(), COLUMN())),1,0,29,1), "TRUE")>0
and the same for false. To highlight the cell you just need to use Highlight Cell Rules (the top option for CF).
I would do this with conditional formatting
Mark all your data and press "Conditional Formatting". Enter 2 rules with Use a formula...
First rule is for TRUE. Assuming that you start with Col A:
=COUNTIF(A2:A31;TRUE)
The second rule is similar, just exchange TRUE by FALSE. Below the formula, press the "Format" button to set the color.
Explanation:
I reverted the logic: Instead of searching for TRUE/FALSE and then format the cells above, I look for every cell if it has at least one entry TRUE resp. FALSE in the next 30 cells. However, I have to admit I don't know how fast Excel can handle such a large amount of data.
I have a problem. For a certain spreadsheet I want to find out the position (only column) of a value smaller than threshold (further called maxt). I have to solve this in VBA as I need them on a different worksheet to give out accumulated numbers.
I am able to retrieve the max smaller than threshold but the vba match function gives back an error that the number couldnt be found.
However, if the value maxt is copied to a cell and I use the the normal match function on the sheet with the cell containing maxt as condition (=MATCH(cell of maxt; range), it works without any issues.
Problem (I only have A to C filled in my example; irrelevant as it doesnt work on only a few constellations).
A B C
8 5 6 -> doesn't work (Error: 1004)
5 6 7 -> works
7 6 7 -> works
4 8 5 -> works
Below is the code.
Dim myVar As Double
Dim myVarAdress As Long
For I = 1 To 10
myVar = Evaluate("=MAX(IF(A" & I & ":M" & I & "<6, A" & I & ":M" & I & "))")
myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & I & ":M" & I))
Next I
End Sub
Thanks in advance
Change myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & I & ":M" & I))
to myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & I & ":M" & I), 0)
That "0" means that you are looking for the exact match. Also you should add a conditon that will skip the 0 value of your "myVar" variable. For example:
If myVar > 0 Then
myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & i & ":M" & i), 0)
End If
Your setup has a couple of different problems that must be addressed before a true solution can be found.
1) You are trying to evaluate a MAX() function, that only has one argument. Your IF() function will either return a value less than 6, or FALSE (0). So either your MAX() function is irrelevant, your IF() function is irrelevant, or you left out one or more arguments on either/both of those functions. In any case, there is no set behavior for what to do when there is no item less than 6 in a row. This raises the possibility that myVar is 0, which is likely to cause faulty results because:
2) You left off the third argument in the MATCH() function. Because your range is (currently) larger than your data set, when you leave off the third argument for MATCH() it will fail any time the data is not organized correctly. This is particularly problematic when you are returning FALSE from your IF() function (treated as 0 by MAX()) because MATCH() is matching to the blanks in your data. Which means that the size of your data set does matter. If you had all 13 rows filled in, your first line would (probably) not fail, but it would not actually match to the 5 you want it to if there were any values LOWER than 5 to the right of column B. Also, it potentially causes some of the other lines to fail if suddenly there aren't any values below 6 in any of the columns and there are no blanks for MATCH() to find and treat as a 0.
All that being said, without further clarification of how you want to clean up these problems, here is a proposed solution (that assumes you want the first occurrence of your max value less than 6, regardless of how many occurrences there are):
Sub MatchSub()
Dim myVar As Double
Dim myVarAdress As Long
Dim rngMaxT As Range
Dim wsFindMax As Worksheet
Set wsFindMax = ActiveSheet
For i = 1 To 10
myVar = Evaluate("=IF(A" & i & ":M" & i & "<6, A" & i & ":M" & i & ")")
Set rngMaxT = wsFindMax.UsedRange.Rows(i)
If rngMaxT(1, 1).Value = myVar Then
myvaraddress = 1
Else
Set rngMaxT = rngMaxT.Find(myVar, , xlValues, xlWhole, xlByRows, xlNext, False)
If rngMaxT Is Nothing Then
'There is no value in the row less than 6
Else
myVarAdress = rngMaxT.Column
End If
End If
Next i
End Sub
I Want to Print Values from 1 to 10 or less in blank cells from range(A1:A10)
If we find any non blank cell in range(A1:A10) then we have to skip the cell and print the values without disturbing the series i.e, 1,2,3,A(non Blank Cell),4,5 etc
i tried
Dim i As Integer
For i = 1 To 10
If Sheets("Data").cell("K" & i).Value Is Nothing Then
Sheets("Data").Range("K" & i).Value = i
i = i + 1
End If
Next i
You would be best using a For Each loop and manually incrementing the i variable each time you do print a number, using the iterated cells row as the row to print the value of i to.
Dim i As Integer, c As Range
i = 1
For Each c In Range("A1:A10")
If Len(c.Value) = 0 Then
Sheets("Data").Range("K" & c.Row).Value = i
i = i + 1
End If
Next c
If Sheets("Data").cell("K" & i).Value Is Nothing Then
In your question text, you mention that the range is from A1:A10. In the code, you mention "K". Unless it's a typo, that may one of the reasons. In addition, replace the above if condition with :
If ((Sheets("Data").cell("K" & i).Value Is Nothing) Or (Trim(Sheets("Data").cell("K" & i).Value) = "")) Then
I have a pretty big spreadsheet (goes all the way to Cell BP584). I'm trying to loop through the values in row S starting at S5 and - where they match my designated variable value - delete certain cells in the area where they're found. I only want to delete the cells from column P to AG - not the entire row. I've placed my code below (VBA). It's not working.
Sub DeleteSelect()
Sheets("DADOS").Select
Dim CurrentDate As Date
CurrentDate = Range("AH2").Value
For i = 5 To 105
If Range("S" & i).Value = CurrentDate Then Range("Pi:AGi").Delete
Next
End Sub
You are pretty close, it just looks like a syntax error in your Delete statement:
Sub DeleteSelect()
Sheets("DADOS").Select
Dim CurrentDate As Date
CurrentDate = Range("AH2").Value
For i = 5 To 105
If Range("S" & i).Value = CurrentDate Then
' Caution - Delete will shift cells.
' You might want to consider ClearContents instead.
Range("P" & i & ":AG" & i).Delete(xlShiftToLeft)
End If
Next
End Sub
As noted in the code above, you may want to consider using ClearContents instead of Delete so you do not have to worry about shifting cell positions.
This program is to convert a column of data from cumulative to non-cumulative. On my sheet I have A1, B1, and C1 with the text Non-Cumulative, Cumulative, and Converted, respectively. I have numbers 1 to 10 beneath A1, then them summed cumulatively beneath B1. C1 is where I want to convert column B back to non-cumulative.
The IsNumeric is used to make the first row of data in C equal to the first row of data in B. It should detect that the title is above the number it is evaluating, thus knowing that no calculations have to be performed. For the rest of them, it'll see that the number above the one it is evaluating is a number, and thus the calculation has to be done.
My problem is that it isn't working. I think the reason is because IsNumeric() keeps coming back as false. Is there a different function I should be using? Do cell references not work in IsNumeric?
Here's the program!
Option Explicit
Dim i As Variant
Sub Conversion()
Sheets("Test Sheet").Select
For i = 1 To 10
If IsNumeric("B" & i) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next
End Sub
The way you wrote your code is logical, just a minor syntax changes you need initially. However,
It's also best to check if the range is empty first...
Then check on if the value is numeric.
Better even, if you set the Range into a Range object and use offset
Code:
Option Explicit '-- great that you use explicit declaration :)
Sub Conversion()
Dim i As Integer '-- integer is good enough
Dim rngRange as Range
'-- try not to select anything. And for a cleaner code
Set rngRange = Sheets("Test Sheet").Range("B1")
For i = 1 To 10
If (rangeRange.Offset(i,0).value) <> "" then '-- check for non-empty
If IsNumeric(rangeRange.Offset(i,0).value) = False Then
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0)
Else
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0) - rangeRange.Offset(i-1,0)
End If
End if
Next i '-- loop
End Sub
To make your code more dynamic:
Another suggestion, you may simply Application.WorkSheetFunction.Transpose() the entire B column range that you need to validate into a variant array
Process the array and Transpose back to the Range with column B and C.
By doing so, you may omit setting for loop size manually but setting it using Lower and Upper bound of the array ;)
You need to check if the range of B i is numeric, not the string "B" & i
and rather than selecting the sheet, simply using a parent identifier like:
sheets("sheet1").range("B" & i)
This will help you avoid errors in your code
For i = 1 To 10
If IsNumeric(sheets("test sheet").range("B" & i).value) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next