Extending Formula - excel

I have a list of values all in a row (500+), like:
AAC80013, /ACY03537, /ADC64131, /AED59827, /AKC13125, /APS84849, etc...
and would like to know to merge them all into one cell so they are as follows:
AAC80013, ACY03537, ADC64131, AED59827, AKC13125, APS84849,
I have tried to do a merge and center and this didn't work. I have however found a way to do this by using an =A4&B4&C4 etc... but I was hoping someone could either advise me of a quicker way to merge them rather than go though and do each one individually.

Based on your question's tags it sounds like you are looking for a simple, non-macro solution.
The process of stitching together multiple text values into one text value is called concatenation. You've discovered one method to do this with formulas using ampersands & between the items. Another is the CONCATENATE() function that can be used in a formula. But frankly, both of these are terrible if you want to do a lot of concatenations. The CONCATENATE() function is particularly irksome because while it should accept a range of values to stitch together, it does not!
So if the concatenation work is complex, the most common way to simplify the workload is to write a VBA macro. But that's programming and requires you to know a few things.
Here is a simple alternative. It is a manual workflow that can make this task very quick and painless.
Let's assume your values are in the range A4:Z4 and also assume that row 5 is empty. Just follow these steps:
1.) In cell B5 enter this formula:
=SUBSTITUTE(A5&A4&B4,"/",", ")
2.) Now copy B5 and select the range C5:Z5 and paste.
3.) By now Z5 will look fearsome. No worries. Copy Z5.
4.) Right-click on the cell you wish to have your final list in and select Paste Special - Values.
5.) Select row 5 and delete all of that.
That's it. It takes about two seconds once you get the hang of it.

Sub combine()
Dim lastCol As Integer, xRow As Integer
Dim cel As Range, rng As Range
Dim delimiter As String, firstCellInfo As String
firstCellInfo = Cells(1, 1).Value
xRow = 1 'change this to the row with your data.
delimiter = "/"
lastCol = ActiveSheet.UsedRange.Columns.Count
Set rng = Range(Cells(xRow, 1), Cells(xRow, lastCol))
For Each cel In rng
If Left(cel.Value, Len(delimiter)) = delimiter Then
Debug.Print Right(cel.Value, Len(cel.Value) - Len(delimiter))
cel.Value = Right(cel.Value, Len(cel) - Len(delimiter))
End If
If cel.Column > 1 Then firstCellInfo = firstCellInfo + ", " + cel.Value
Next cel
Cells(2, 1).Value = firstCellInfo
End Sub
Note: Change the xRow to whatever row has your data. Also, there's a delimiter / in each cell except the first one - so the loop will remove that, if it exists, and add the result to a string firstCellInfo. At the end of the loop, I placed this combined data into B1 - just so you can run this and make sure this works. If you want to put the info back in A1, just change Cells(2,1).Value to Cells(1,1).Value.
Also, if you want to delete the extra data (columns B onward), just add this after the Cells(2,1).Value = firstCellInfo:
Set rng = Range(Cells(xRow, 2), Cells(xRow, lastCol))
rng.Clear

Related

Pasting Values as Displayed

I have a column of cells in excel that have the following formatting: "0000.00"
FYI, the quotes are not part of formatting.
Basically, four digits followed by two decimals. However, when the numbers are like "600", they need to be displayed as "0600.00". However, the list of numbers provided to me are displayed that way through formatting, so if I am trying to VLOOKUP, it can't process it; it sees "600", not "0600.00" that is displayed to me.
I am aware of PasteSpecial Paste:=xlPasteValues, but this pastes "600", not the "0600.00" that is displayed to me. Currently I can achieve such results by copying the values and pasting them into notepad —which suggests to me there is a way to do this— but I'd like to create a macro to do this for me.
Sorry for any redundant explanation, just wanted to avoid getting answers relating to pasting values only, which is not what I am looking for.
As you said, to use VLOOKUP with formatted text as the lookup value, you'll need the value of the cell to match with the value of the lookup value, so you'll have to convert the value in the cell to text with something like this (example for a single cell):
Dim rng As Range
Set rng = Range("A1")
rng.PasteSpecial xlPasteFormulasAndNumberFormats
Dim TextValue As String
TextValue = Format(rng, rng.NumberFormat)
rng.NumberFormat = "#" 'We need this line to turn the cell content into text
rng.Value2 = TextValue
I'm pretty sure no PasteSpecial options will allow you to do what you want in a single operation, so this solution is a workaround that does it in two steps.
Multiple cells case:
I realize that the code above doesn't address the issue of pasting multiple cells, so here's a procedure that can be used to copy the formatted number as text from one range to another:
Sub CopyAsFormattedText(ByRef SourceRange As Range, ByRef DestinationRange As Range)
'Load values into an array
Dim CellValues() As Variant
CellValues = SourceRange.Value2
'Transform values using number format from source range
Dim i As Long, j As Long
For i = 1 To UBound(CellValues, 1)
For j = 1 To UBound(CellValues, 2)
CellValues(i, j) = Format(CellValues(i, j), SourceRange.Cells(i, j).NumberFormat)
Next j
Next i
'Paste to destination by using the top left cell and resizing the range to be the same size as the source range
Dim TopLeftCell As Range
Set TopLeftCell = DestinationRange.Cells(1, 1)
Dim PasteRange As Range
Set PasteRange = TopLeftCell.Resize(UBound(CellValues, 1), UBound(CellValues, 2))
PasteRange.NumberFormat = "#" 'We need this line to turn the cells content into text
PasteRange.Value2 = CellValues
End Sub
It's basically the same idea, but with a loop.
Note that if the formatting is always the same, you could make it a variable and apply it to every values in the array instead of calling .NumberFormat on every cell which inevitably adds a little bit of overhead.
Sidenote
One could ask why I'm not suggesting to use :
SourceRange.Cells(i, j).Text
instead of
Format(CellValues(i, j), SourceRange.Cells(i, j).NumberFormat)
And that would be a very good question! I guess, the fact that .Text can return "###..." when the column isn't sized properly always makes me afraid of using it, but it certainly would look much cleaner in the code. However, I'm not sure what would be better in terms of performance. (Relevant article by Charles Williams)

AdvancedFitler Out Values from ListRange using Formula

I'm trying to setup AdvancedFilter to filter out a ListRange of items. After some testing, I realized that it only accepts using a "formula" of <>A when I use a criteria range of 2 cells. If I add a third <>B it just does nothing.
My original thought was simple to prepend to my column <> to each cells value, but now it seems that won't work. I need to figure out a way to have both a formula and a range somehow applied.
IE:
Data:
Let Num
A 1
B 2
C 3
This Works for Filter Range:
Let
<>B
This Doesn't:
Let
<>B
<>C
But my CriteriaRng looks like this:
Let
B
C
How I can reference a way to say for all items in Let column, Filter <>Cell.Value in CriteriaRange:=
Here's the basic code I tried/debugged this issue with:
FilterRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("D1:D3"), Unique:=False
Stop
FilterRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("D1:D2"), Unique:=False
Stop
Updates:
I found this example --> https://www.mrexcel.com/board/threads/with-adavnced-filter-how-do-i-exclude-a-value.733153/page-2
=ISNA(MATCH($A9,Exclude!$A$1:$A$2,0))
But I'd need to built that formula via VBA and make it much more generic. I'm better w/ VBA then formula's.
I also read in this post that he basically uses highlighting via regular filter, then another filter based on highlighting, but I know there is a better way utilizing a formula in a cell.
https://stackoverflow.com/a/34012365/5079799
I think I also somewhere you can do "or" operations when staggering rows w/ advanced filter, so I could make my column a staggered column, but that also sounds hacky and I couldn't get it to work on my brief attempt.
If you have multiple lines in your Criteria you're doing an OR operation. If you want to do an AND operation you need a single line in your criteria but the same Caption listed multiple times, see below.
If you name your ranges: Database, Criteria, and Extract respectively then record a macro and run the advanced filter it will write the code for you. You can then modify the code to accept variable input.
I basically copied my answer from this one, but built the FormulaStr and automated it more, as thats the point of VBA!
https://stackoverflow.com/a/28506854/5079799
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim CriteriaRng As Range, DataRng As Range
Set CriteriaRng = ws.Range("D1:D3")
Set DataRng = ws.Range("A1:B4")
Dim FormulaRng As Range, FormulaStr As String, DataRngCellTwoStr As Range
Set DataRngCellTwoStr = Cells(DataRng.Row + 1, DataRng.Column)
Set FormulaRng = ws.Range(Cells(2, CriteriaRng.Column + 1), Cells(2, CriteriaRng.Column + 1))
FormulaStr = "=ISNA(MATCH(" & DataRngCellTwoStr.Address(False, False) & "," & CriteriaRng.Address & ",0))"
FormulaRng.Value = FormulaStr
ws.Range(Cells(1, CriteriaRng.Column + 1), Cells(1, CriteriaRng.Column + 1)).Clear
Set FormulaRng = ws.Range(Cells(1, CriteriaRng.Column + 1), Cells(2, CriteriaRng.Column + 1))
DataRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=FormulaRng, Unique:=False
End Sub
Notes:
You must enter Formula on 2nd row and make FilterRng exactly 2 rows!
The Header Should be BLANK
Formula should looks like this =ISNA(MATCH(A2,$D$1:$D$3,0)) with A2 being first row below headers of criteria column in filter range and D1:D3 being the criteria column.

Copy (Named) Table multiple times within the same sheet and change the tables names

I'm building a project management spreadsheet where multiple teams are going to have a copy. I want to create a simple address book. I have the names of the teams in a table and using VBA, I create the Master Table.
In the range B4:D5 there is a simple table with three column names:
Name
Telephone
Email
I have named this table (in Name Manager) as ContactTeam1
I want to copy and paste this exact 3x2 table to be below each corresponding team such as the image Here and change each Named Table as ContactTeam2, ContactTeam3 and so on.
The reason I want to use VBA is because, we have many different projects, so I want to automate the process as much as I can, for future projects as well.
I will fill in the tables with all the necessary information (Names,Phones,Emails) - by hand. The reason I want to use tables is that it has the benefit to auto-expand to include any new lines below the last.
As a bonus functionality, when somebody clicks the cell on top that contains the name of the Team. (Team Blue, Team Red etc.) all the emails of the corresponding range will be copied to clipboard, to be used in an email client. (This can be done easier with tables - one more reason I want to use them).
I hope this helps
Sub Bouton()
Dim cell As Range
Dim rng As Range
Dim cnt As Integer
Dim RangeName As String
Dim CellAdd1, CellAdd2 As String
For cnt = 2 To ActiveSheet.Range("NumberTimes")
Set rng = Range("ContactTeam" & (cnt - 1))
RangeName = "ContactTeam" & cnt
CellAdd1 = Cells(rng.Row, rng.Column + 3).Address
CellAdd2 = Cells(rng.Row + 1, rng.Column + 5).Address
'+ 1 in the row so the named range goes from B4 to D5
Set cell = ActiveSheet.Range(CellAdd1, CellAdd2)
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
Range("ContactTeam1").Copy Range("ContactTeam" & cnt)
Next cnt
End Sub
I'm not the best in VBA, but what this does is that it creates a new range each 3 cells and names it from ContactTeam2 to whatever your limit is. I created a named range called NumberTimes. Basically, you tell it how many new ranges you want to be created.
easiest of all, i guess we can use dictionary here. would be faster but here he what i tested/tried , EXACTLY on your data and works.
Sub d()
Sheet1.Select
Range("b3").Select
Do
Range("b3:d4").Name = "mainteam"
ActiveCell.Offset(0, 3).Select
Range("mainteam").Copy ActiveCell
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Name = "team" & i
i = i + 1
Loop While i <> 5
End Sub

Excel macro to move rows based on cell criteria without moving the formatting

I'm using the following macro to move rows from one sheet to another. This part works like a charm. What I'm trying to figure out is how to do this without affecting my conditional formatting.
Sub MoveCompleted()
Dim h As Variant
Dim endrow As Integer
Dim OL As Worksheet, Cmp As Worksheet
Set OL = ActiveWorkbook.Sheets("Open_Log")
Set Cmp = ActiveWorkbook.Sheets("Completed")
endrow = OL.Range("A" & OL.Rows.Count).End(xlUp).Row
For h = 2 To endrow
If OL.Cells(h, "H").Value = "COMPLETE" Then
OL.Cells(h, "H").EntireRow.Cut Destination:=Cmp.Range("A" & Cmp.Rows.Count).End(xlUp).Offset(1)
End If
Next
End Sub
I have images to post including my formatting but my rep is too low on this site to post them.
Quick example:
before running macro the "Applies to" looks like: =$A$12:$I$100000
after running the macro it looks like: =$A$12:$I$63,$A$68:$I$100000
leaving the gap(s) where the previously moved rows were.
It seems there is no way short of resetting the conditional formatting after the move. (Issue has been mentioned a few times on SO before).
I think you might want to reconsider what you are trying to do by going about it in a slightly different way.
Instead of REMOVING the whole row, you could just clear it.
Also, instead of copying the whole row, you could set the values for each cell very easily with a loop. That would preserve the formatting in the cell. I'm sure there are other ways to do this, but I'm all in favor of showing people how to run simple loops, instead of recording cut and paste from macros.
Try putting this bit of code into what you already have going.
LastCompletedRow = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row
LastCol = Sheets("Open_Log").Cells(1, Columns.count).End(xlToLeft).Column 'Get the last column on the source.
For h = 2 To endrow
If OL.Cells(h, "H").Value = "COMPLETE" Then
For col = 1 To LastCol
Sheets("Completed").Cells(LastCompletedRow, col).Value = Sheets("Open_Log").Cells(h, col).Value
Sheets("Open_Log").Cells(h, col).Value = "" 'Clear the original cell you just copied.
Next col
End If
Next

Excel VBA - Substring & Paste

I have a column that has U.S. state abbreviations (MI, NY, FL, etc.). I have an issue where there is an observation that is listed as "NJ NJ". This observation moves around within the same column each week.
I want to create a macro that substrings each observation to two characters and just drops everything afterwords.
Would I be able to use the Mid function to grab the first two characters, and then paste it overtop of the original value. Further, would it be appropriate to offset by one or is there a way to do it all at once?
Thanks!
Assuming you have your List in the 1st Column, starting at Row 1, the following Macro will do it. Obviously you can make a lot of improvements and error checks to the code, but this should get you started.
Sub FixStates()
Dim lRow As Long
Dim lCol As Long
Dim strContent As String
lRow = 1
lCol = 1
Do While Cells(lRow, lCol) <> ""
strContent = Trim(Cells(lRow, lCol))
If Len(strContent) > 2 Then Cells(lRow, lCol) = Left(strContent, 2)
lRow = lRow + 1
Loop
End Sub
If you want your result to be offset by one cell from the source cell, then the formula by Daniel Cook works fine.
On the other hand, if you want your result to overwrite the source cell, you would have to copy the cell with the result (using the same formula as above) and paste-special as value on top of the source cell (you can do this for many cells at once), or write a VBA sub.
I personally find it simpler the "copy and paste-special as value" way.

Resources