I have 3 columns in a sheet in excel as below
I need the output in the below format on a SEPARATE SHEET
I'm fine with either VB script or using just excel features. Could I please get some help?
Try this macro. Place the macro in a regular code module (Insert > Module). Adjust the ranges to suit your situation.
Sub rearrange()
Dim cel As Range, tgt As Range
Set cel = ActiveSheet.Range("A1")
Set tgt = ActiveSheet.Range("D1")
Do While Len(cel) > 0
tgt = cel
tgt.Offset(1, 0) = cel.Offset(0, 1) & cel.Offset(0, 2)
Set cel = cel.Offset(1, 0)
Set tgt = tgt.Offset(2, 0)
Loop
ActiveSheet.Range("A:C").Delete
End Sub
If you're not going to do this on a regular basis, here's a simple solution.
I don't have access to MS-Excel so I cannot give you the exact answer. But I hope this helps.
Steps:
Add a new column with the concatenate function to the right of the table for example, to merge cells b1 and c1, use =Concatenate(b1,c1) and keep this result in cell D1. Do a copy-paste of the function for the other rows as well.
Copy your selection to a new worksheet where you want the result.
Use paste special to only paste the values of copied cells without forumulas. This ensures that it won't reference the original cells or change relatively.
Use the transpose function to change the resulting contents like your final output while pasting the data. Similar one here.
If you need to do this regularly, this method is not suitable. You'll be better off with a VBA script. But it's been a very long time since I worked on Excel so I cannot help you there.
Related
I want to copy background color for example sheetA cell A1 to
sheet B A1.
The cell A1 is using conditional formatting, I can copy simple but not with conditional formatting enabled.
Here is the code
Public Sub CopyColor()
Dim PeopleSheet As Worksheet
Dim TargetSht As Worksheet
'Define what our source sheet and target sheet are
Set PeopleSheet = ThisWorkbook.Worksheets("People")
Set ProcessSheet = ThisWorkbook.Worksheets("Process")
Set TechnologySheet = ThisWorkbook.Worksheets("Technology")
Set BusinessSheet = ThisWorkbook.Worksheets("Business")
Set TargetSht = ThisWorkbook.Worksheets("Summary")
Set s1 = PeopleSheet.Range("G3:G9").FormatConditions(1)
Set t1 = TargetSht.Range("F15:F21")
t1.Interior.Color = s1.DisplayFormat.Interior.Color
Last line t1.Interior.Color = s1 give error Run-time error '13': Type mismatch
Update
UPDATE 2 #Ralph
This is the result of before and after application of code, respectively.
Only f15 is effected not others?
UPDATE 3
This is the best evidence I can come up, when I run the VB it just select the target cells and ask me to PASTE the results. So the bottom left status bar in video.
To copy over only the format (which includes the conditional format) from A1 on sheetA to A1 on sheetB you can use the following:
Worksheets("sheetA").Range("A1").Copy
Worksheets("sheetB").Range("A1").PasteSpecial xlPasteFormats
If you don't want to give up on the current conditional formatting on cell A1 on sheetB and just want to add the conditional formatting from A1 on sheetA you can also use xlPasteAllMergingConditionalFormats. Yet, then the value will get copied over and you'll have to store that (to write it back again afterwards). So, the complete code in this case might be something like this:
Dim strTemp As String
strTemp = Worksheets("sheetB").Range("A1").Formula
Worksheets("sheetA").Range("A1").Copy
Worksheets("sheetB").Range("A1").PasteSpecial xlPasteAllMergingConditionalFormats
Worksheets("sheetB").Range("A1").Formula = strTemp
Update:
Apparently, the sheet names and the ranges have changed (in the update). So, the updated code should be:
Dim varTemp As Variant
varTemp = Worksheets("Summary").Range("F15:F21").Formula
Worksheets("People").Range("G3:G9").Copy
Worksheets("Summary").Range("F15:F21").PasteSpecial xlPasteAllMergingConditionalFormats
Worksheets("Summary").Range("F15:F21").Formula = varTemp
Note, that you want to store several formulas at once. Hence, you'll need an array variable to hold it and not a string variable anymore.
I am not sure what you are doing. But it certainly works for me (as it should):
Why not take out the DisplayFormat and leave it like this:
t1.Interior.Color = s1.Interior.Color
This should work - at least as I understand what you're asking
Set s1 = PeopleSheet.Range("G3:G9").DisplayFormat
Set t1 = TargetSht.Range("F15:F21")
t1.Interior.Color = s1.Interior.Color
I am very new to vba and basically only use it when amending a range value (having previously recorded the script using a macro in excel). Since I add/delete rows in excel I have to go to the vba script and manually update the range part. So if my range on the excel sheet has expanded from A2:R83 to A2.R84 heres one of the parts I update from:
Range("A2:R83").Select
To:
Range("A2:R84").Select
Is there a way I can specify a cell that vba can take the range values from? eg can I, on the excel sheet cell X1 input A2 and in cell Y2 input R84 and have the vba script reference these cells to determine the current range?
Appreciate any help!
I believe this will do what you want, :
Sub test()
Dim s1 As String, s2 As String
s1 = Sheet1.Range("A1"): s2 = Sheet1.Range("B1")
Range(s1 & ":" & s2).Select
End Sub
You will, however, run into trouble if the values in A1 and B1 are not valid cell-names, so some input validation may be a good idea.
I found that it is possible to make the validation range dinamic using INDIRECT.
1.- In location that you choose (in the example I use X1 in sheet1) put
="'Sheet1'!"&"A2:"&"R"&COUNTA(R1:R2000)
I put R2000 to have plenty space in case the range grows, change to a size that suits you. The result of this formula will be a range. Its size will change every time you put something new in R because of the Counta.
2.- In the validation section place this formula when you record it.
=INDIRECT('Sheet'!$X$1)
This makes the validation read the range based on what x1 says.
This will figure your range,
Sub SelectRng()
Dim Rws As Long, Rng As Range
Rws = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(2, "A"), Cells(Rws, "R"))
Rng.Select 'or whatever you want to do with it.
End Sub
Range1.Copy
Range2.PasteSpecial Paste:=xlPasteFormulas, SkipBlanks:=True
If Range1 and Range2 have the same dimensions, this code executes without any trouble. The expectation is that the formulas in the range you copied will get inserted into the target range, but any blank cells in Range1 will not have their formulas copied to Range2, instead, any current cell values will be left as they were.
I've discovered that this fails on merged cells. The image below demonstrates the equivalent action using the built in Paste Special UI, which fails in an identical fashion:
Can anyone think of an elegant workaround that doesn't involve looping?
Note that simply using a variant of Range1.Formula = Range2.Formula won't suffice since it will overwrite unwanted cells in Range2 with blank (empty) values.
I've removed the no loops restriction because there doesn't seem to be a perfect solution otherwise.
The following was tested and seems to work.
Assumptions:
The first row cells in your post are A1:E1.
The green highlighted row cells in your post are A2:E2.
The range that needs to be partially overwritten is in row 4 (A4:E4).
I have replicated the contents of cells A2:E2 all the way till cell Q2. SoF2:G2 are merged & blank, H2 is blank, I2 has "copy", and so on till Q2 (which has "copy"). I just wanted to make sure that the method works with multiple merged areas.
Sub skipBlanksWithMergedCells()
Dim rngOrigin As Range, rngDestination As Range, rngSkip As Range
Dim varTemp As Variant
Set rngOrigin = Range("A2:Q2")
Set rngDestination = Range("A4:Q4")
' Set pointer to range that needs to be skipped
Set rngSkip = rngOrigin.SpecialCells(xlCellTypeBlanks).Offset(2, 0)
' Store its values into a variant
varTemp = rngSkip.Value
rngOrigin.Copy
rngDestination.PasteSpecial xlPasteFormulas
' Revert original values from the variant
rngSkip.Value = varTemp
End Sub
This will work if rngSkip contains hard numbers or text, but it will fail if it contain formulas.. In that case, we need to set a pointer to the subrange of formulas and store them in another variant, using varTempFormulas=range.formula and then back again range.formula=varTempFormulas.
I hope this helps.
Based on the conclusion that this bug makes it impossible to do this without looping, I've come up with the following solution which I believe to be as elegant as possible with looping.
Dim col as Long
Dim cel as Range
For Each cel In src.Cells
If cel.Formula <> vbNullString Then
col = 1 + src.Column - cel.Column
cel.Copy
dst.Worksheet.Range(dst.Cells(1, col ), dst.Cells(dst.rows, col )).PasteSpecial Paste:=xlPasteFormulas
End If
Next cel
This lets you copy one row of data from a range src and paste formulas over multiple rows in a range dst with only one loop over the columns, while skipping blank. This method never overwrites any destination that should be left alone, so it works in all my use cases.
In a more complex situation where the source data had multiple rows as well as columns, this routine wouldn't work, and I imagine at least 2 levels of nested loops would be required.
Brute Force method:
I had this problem and used this solution.
Copy format for whole page to new temporary page.
Un-merge your page. Do your copy with skip blanks.
Copy format from temporary page to old page.
Delete temporary page.
I have a spreadsheet with a large amount of data in. About half the cells are merged horizontally with other cells and contain names e.g. John Doe.
Does anyone know how to write a macro to unmerge the cells while distributing the value of the cell to all the cells that were previously merged?
Cheers
Jack
EDIT: The reason I am doing this is to check to see if two adjacent cells are equal i.e. is A1 = A2. But I run into problems when either cell is merged. If anyone knows a way around this problem without separating the cells and copying the data that would be even better!
The idea I provide below is tested for Excel 2010 VBA Win7. However, being not sure I hope it should work as for Mac, too (as this is rather set of standard properties and methods of Range object). If this doesn't work please let me know to delete my answer.
This simple code will work for selected area however it's quite easy to change it to any other range. Some other comment inside the code below.
Sub Unmerging_Selection()
Dim tmpAddress As String
Dim Cell As Range
'change Selection below for any other range to process
For Each Cell In Selection
'check if cell is merged
If Cell.MergeCells Then
'if so- check the range merged
tmpAddress = Cell.MergeArea.Address
'umnerge
Cell.UnMerge
'put the value of the cell to
Range(tmpAddress) = Cell
End If
Next
End sub
And the picture presenting before and after result:
I was able to get the solution from KazJaw to work on a mac with one edit, changing Cell.UnMerge to
ActiveSheet.UsedRange.MergeCells = False, as provided by Ron Debruin here: http://www.rondebruin.nl/mac/mac027.htm.
Sub Unmerging_Selection()
Dim tmpAddress As String
Dim Cell As Range
'change Selection below for any other range to process
For Each Cell In Selection
'check if cell is merged
If Cell.MergeCells Then
'if so- check the range merged
tmpAddress = Cell.MergeArea.Address
'umnerge
ActiveSheet.UsedRange.MergeCells = False
'put the value of the cell to
Range(tmpAddress) = Cell
End If
Next
End sub
I'm trying to create a simple macro that copys the two first numbers in each cell in a column and printing them in a different column. This is in a excel-document with more than 1 worksheet. I've tried for a while to write the code, but with no prior experience, I have a hard time figuring out what to do. I know the "left()"-function is able to do this, but I don't know how I define which column to draw data from and to which column it will be printed. Any help will be greatly appreciated.
With no prior experience to writing VBA code, I am going to reccommend you stick to the formula method of doing. Honestly, even if you were familiar with VBA, you might still opt to use the formula.
A formula is put into the actual cell you want the value to be copied.
=LEFT(sourceCell, #of characters you want)
This is how it would look:
=LEFT(Sheet1!A1, 2)
Think of it as saying "this cell shall equal the first n characters in cell OO, starting from the left".
Once you are done with your formula, if you don't need it to be binded to the source anymore (if the sourceCell changes, so does the cell with the LEFT formula), you can highlight the cells, Ctrl + C to copy, then right-click and select Paste Special. Then select VALUE and hit OK and now the cells are hard-coded with the value they were showing, as if you typed it yourself.
Once you master using formulas, the next step is VBA. Don't go confusing yourself by jumping into VBA and writing code for ranges, etc. if you aren't comfortable with using =LEFT yet. One step at a time, and you'll be a pro before you know it. :)
Here is a quick sample sub to get you started:
Public Sub LeftSub()
Dim SourceRange As Range, DestinationRange As Range, i As Integer
'Define our source range as A1:A10 of Sheet1
Set SourceRange = Sheet1.Range("A1:A10")
'Define our target range where we will print.
'Note that this is expected to be of same shape as source
Set DestinationRange = Sheet1.Range("B1:B10")
'Iterate through each source cell and print left 2 bits in target cell
For i = 1 To SourceRange.Count
DestinationRange(i, 1).Value = Left(SourceRange(i, 1).Value, 2)
Next i
End Sub
How about
Sub foo()
Dim cell As Range
Dim sourceRange As Range
'//define the source column - looks for contiguous downward data from A1;
Set sourceRange = Range(Sheets("Sheet1").Range("A1"), Selection.End(xlDown))
'//iterate each cell
For Each cell In sourceRange
If IsEmpty(cell.Value) Then Exit For
'//example to place the value in corresponding row of column B in sheet 2
Sheets("Sheet2").Range("B" & cell.Row).Value = Left$(cell.Value,2)
Next
End Sub
Or an equivalent formula (in the destination cell)
=LEFT(Sheet1!A1,2)