I am trying to merge cell in the adjacent row into cells that are already merged. I want to merge an adjacent cell in column C, if the adjacent cell in column D is merged. Not all cells are merged in column D. I have code below that provides me with the correct row numbers when I use the variable in a MsgBox, however, when I add the variable to a Range to be merged, every row gets merged. I am thinking it must be some simple, but I just can determine what is causing every row in the range to get merged. I normally don't mess with merging anything, but I need to leave the spreadsheet with these merged cells. Your help to crack this one will be greatly appreciated.
Sub FindMerge()
Dim cell As Range
Dim Lrow As Long
Application.ScreenUpdating = False 'Turn off screen updating. Code runs faster without screen flicker
Application.DisplayAlerts = False 'stops Windows Alerts from poping up
'loops through range to find merged cells
'For Each cell In ActiveSheet.UsedRange 'commented out to try static range below.
For Each cell In Range("D1:D81")
If cell.MergeCells Then
If cell.Address = cell.MergeArea.Cells(1, 1).Address Then
' Msgbox "Row: " & cell.row 'displays correct row number where merged cell is located
Lrow = cell.row
Range("C2:O" & Lrow).Merge True 'Unintentionally merges every row
End If
End If
Next cell
Application.ScreenUpdating = True 'Turns screen updating back on
Application.DisplayAlerts = True 'Turns Windows Alerts back on
End Sub
You're merging all rows starting from row 2 by doing this:
Range("C2:O" & Lrow).Merge
What you most likely want is this:
Range("C1:O1").Offset(Lrow - 1).Merge
Related
I'm getting data that is in 1, 2, or 3 columns (possibly more). I need each row to combine the data in the respective row without losing any of the data from any columns.
I managed to get some code together that will combine the cells properly, but I'm struggling to use this code to look through each row and combine the cells in that row, for all rows that contain data.
Here is what I have so far:
Sub JoinAndMerge()
'joins all the content in selected cells
'and puts the resulting text in top most cell
'then merges all cells
Dim outputText As String
Const delim = " "
On Error Resume Next
For Each cell In Selection
outputText = outputText & cell.value & delim
Next cell
With Selection
.Clear
.Cells(1).value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
End Sub
And here's what I've got as far as trying to get it to look through each row.
Sub JoinAndMerge2()
'joins all the content in selected cells
'and puts the resulting text in top most cell
'then merges all cells
Dim outputText As String
Const delim = " "
On Error Resume Next
Dim cell_value As Variant
Dim counter As Integer
Dim xlastRow As Long
Dim xlastColumn As Long
xlastRow = Worksheets("Sheet48").UsedRange.Rows.Count
xlastColumn = Worksheets("Sheet48").UsedRange.Columns.Count
'Looping through A column define max value
For i = 1 To xlastRow
'Row counter
counter = 1
'Take cell one at the time
cell_value = ThisWorkbook.ActiveSheet.Cells(1, i).value
For Each cell In Selection
outputText = outputText & cell.value & delim
Next cell
With Selection
.Clear
.Cells(1).value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
counter = counter + 1
Next i
End Sub
How do I get this to loop properly through each row?
If it helps, before on left, after on right:
I never recommend merging cells, but if you must...
This is dynamic by row (determined by Column A) and column. Each merge size is dependent on each rows furthest right non-blank column. Therefore, some merged cells will span 2 columns and some will span 3. If you don’t want that to be the case, you will need to find the max used column and merge by that column index
I.E. replacing MyCell.Resize(1, i -1).Merge with MyCell.Resize(1, MaxCol).Merge where MaxCol is your max used column.
Option Explicit
Sub Merger()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim MyCell As Range, Merged As String, i, iArr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each MyCell In ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
For i = 1 To ws.Cells(MyCell.Row, ws.Columns.Count).End(xlToLeft).Column
Merged = Merged & Chr(32) & MyCell.Offset(, i - 1) 'Build String
Next i
MyCell.Resize(1, i - 1).Merge 'Merge
MyCell = Right(Merged, Len(Merged) - 1) 'Insert String
Merged = "" 'Reset string for next loop
MyCell.HorizontalAlignment = xlGeneral
MyCell.VerticalAlignment = xlCenter
MyCell.WrapText = True
Next MyCell
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
It can't be stressed too much. Merged cells should be avoided.
They play havoc when dragging an area to populate cells. They interrupt the double click autofill and make copying and pasting an exercise in frustration. They delay development and add complexity to formulas and VBA code all the while creating more opportunities for an error to occur or a bug to go unnoticed.
So i urge you to reconsider using merged cells.
Almost to prove the point, you'll find "*****" on a few lines in the two solutions below. Each one of those lines needs to be handled uniquely. Care to guess why? The merged cell you currently have in row 1. That merged cell can cause those lines to either halt with an error or continue with the possibility of unwanted consequences depending on which cell addresses actually hold row 1 data.
Merged cells are absolutely horrid and considered among the greatest of Excel sins.
Here are two ways forward without merged cells...
In VBA (psuedo code)
For (Columns, 2, LastColumn, Step 2)
For(Rows, 3, LastRow)
With Worksheet
If .Cells(Row,Column) <> vbNullString then
.cells(Row,Column-1)=.cells(Row,Column-1).Value2 _
& StringDeliminator & .cells(Row,Column).Value2
End If
End with
Next Rows
Columns (Column).EntireColumn.Delete*****
Next Columns
Using formulas in a worksheet
Add a new column C
In cell C3 use the formula
=If(A3<>"",C3=A3 & " " & B3,"")
Drag the formula down(copy to other columns if needed)
Ctrl Shift Up to select all the formulas
Copy *****
Paste Special Values *****
Delete columns A and B *****
There is one situation where merged cells are ok...
if you're in a situation where you're against the wall, there is nothing you can do because your manager doesn't care if your work is incompatible with his analyst's automation tools and refuses to accept center across selection as a viable alternative because "i know what center does and it does not help, you have to merge cells to get the text centered over those columns ".... if this is your situation then merged cells are ok, just use this method:: first, start looking for another job (or a promotion above your manager, your company should already be looking) and second, submit the broken merged cell version to the snowflake and quitely slip the functional version to your analyst as a preliminary estimate
That's the only time I authorize you to use merged cells.
I have an sheet Data. In column J of data I look for the text "delayed".
If it contains this text delayed, then I copy the complete row to another sheet"Delayed".
The Problem here while copying is the column is entered manully, and in some cases the sapce and cases of letters varies.
So, I would like to know, is there a way, Irrespective of text case, and the gaps, I can copy the complete row to next sheet.
I have the below code, to check if it is delayed and copy data to the sheet "Delayed". Any lead with this would be helpful
Sub delay()
Dim cell1 As Range
Dim nextrow1 As Long
Dim a1 As Double
Application.ScreenUpdating = False
a1 = Application.WorksheetFunction.CountA(Sheets("Data").Range("J:J"))
For Each cell1 In Sheets("Data").Range("J5:J" & a1)
If cell1.Value = "delayed " Then
nextrow1 = Application.WorksheetFunction.CountA(Sheets("Delayed").Range("J:J"))
Rows(cell1.Row).Copy Destination:=Sheets("Delayed").Range("A" & nextrow + 1)
End If
Next
Application.ScreenUpdating = False
End Sub
I'm programming a table to display rows based on numeric values in one cell and text values in another (a drop down list). I completed the code for the rows, but can't seem to get my head around the columns.
Edit: What I'm trying to do is display one or two of many columns depending on what input value I have in a dropdown. At the same time as the number of rows displayed are dependent on another cell. E.g. if I have three types of candy, one per column. And in the rows I display how many of said candies I eat per day. I want to display only one of the candies, for x days. How do I code this? The row-part I solved, the column - i need help.
This is my current code, how should I go about solving my predicament?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("Time_horizon")) Is Nothing Then
TH_row_update
TH_column_update
End If
End Sub
Public Sub TH_row_update()
Dim cell As Range
For Each cell In Range("Time_horizon_Year")
If cell.Value >= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
Public Sub TH_column_update()
Dim cell As Range
For Each cell In Range("comparator_range")
If cell.Value = ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
If you want to go trough colums and cells:
For Each col In Range("comparator_range").Columns
Debug.Print "column " & col.Address
For Each cel In col.Cells
Debug.Print " - cell " & cel.Address
Next cel
Next col
So lets say your range is A1:C5
The first for each will run for each column that exists in this range mean A B C
The second for each trough every cell inside of the colum, means A1-A5, B1-B5, C1-C5
Hope this help you already, if you need more informations just tell it.
I have a range of cells B2:AB40.
If every cell in each row within the the range is blank (by which I mean no text or numbers, just colour fill and border formatting), I want to hide the whole of the row using a macro.
e.g.
If every cell in the range B2:AB2 is blank then hide all of row 2.
If every cell in the range B3:AB3 is blank then hide all of row 3
If every cell in the range B4:AB4 is blank then hide all of row 4..etc etc etc
Up to and including row 40.
N.B. Each cell in column A and AC in every row adjacent to the specified range will always have text (someone's name and a formula result respectively) and this cannot be changed.
I have seen various ways of doing this based on a single cell but cannot seem to adapt them for my purposes.
Any help is appreciated.
Consider:
Sub RowHider()
Dim I As Long, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
For I = 2 To 40
If wf.CountA(Range("B" & I & ":AB" & I)) = 0 Then
Rows(I).Hidden = True
Else
Rows(I).Hidden = False
End If
Next I
End Sub
Note the usage of a worksheet function in VBA.
Try this
Sub HideRangeIfEmpty()
If Application.WorksheetFunction.CountA(Range("b2:AB2")) = 0 Then
Range("b2:AB2").EntireRow.Hidden = True
End If
End Sub
The code below would search through a row and its associated columns.
For Row 7, if it is a "N" or "TR" and if all entries are blank below line 12,the code would hide the entire column.
However, I still need help with some further help!
If there is a "N" or "TR" in row 7. If there is something writen in any cell, (rather than leaving it alone), can I highlight its associated cell in row 7 in yellow?
If ther eis a "Y" in row 7, If there is any empty cells, can I highlight its associated cell in row 7 in yellow?
Thank you so much! special thanks to KazJaw for my previous post about simular issue
Sub checkandhide()
Dim r As Range
Dim Cell As Range
Set r = Range("A7", Cells(7, Columns.Count).End(xlToLeft))
For Each Cell In r
If Cell.Value = "N" Or Cell.Value = "TR" Then
If Cells(Rows.Count, Cell.Column).End(xlUp).Row < 13 Then
Cell.EntireColumn.Hidden = True
End If
End If
Next
End Sub
attached example of spreadsheet
Here you have an improved version of your code (although I might need further clarifications... read below).
Sub checkandhide()
Dim r as Range, Cell As Range, curRange As Range
Set r = Range("A7", Cells(7, Columns.Count).End(xlToLeft))
For Each Cell In r
Set curRange = Range(Cells(13, Cell.Column), Cells(Rows.Count, Cell.Column)) 'Range from row 13 until last row in the given column
If Cell.Value = "N" Or Cell.Value = "TR" Then
If Application.CountBlank(curRange) = curRange.Cells.Count Then
Cell.EntireColumn.Hidden = True
Else
Cell.Interior.ColorIndex = 6 'http://dmcritchie.mvps.org/excel/colors.htm
End If
ElseIf Cell.Value = "Y" Then
If Application.CountBlank(curRange) > 0 Then
Cell.Interior.ColorIndex = 6 'http://dmcritchie.mvps.org/excel/colors.htm
End If
End If
Next
End Sub
I am not sure if I have understood your instructions properly and thus I will describe here what this code does exactly; please, comment any issue which is not exactly as you want and such that I can update the code accordingly:
It looks for all the cells in range r.
If the given cell (which might be in row 7 or in any other row below it) meets one of the conditions, the corresponding actions would be performed.
Part of the conditions depends on curRange, which is defined as all the rows between row number 13 until the end of the spreadsheet.
Specific conditions:
a) If the value of the current cell is N or TR. If all the cells in curRange are blank, the current column is hidden. If there is, at least, a non-blank cell, the background color of the given cell would be set to yellow.
b) If the value of the current cell is Y and there is, at least, one cell in curRange which is not blank, the background color of the background cell would be set to yellow.