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)
Related
Am trying to make a VBA validation sheet on Excel to find all the cells that do not match a predefined pattern and copy it to another sheet
My pattern is "4 numbers/5 numbers"
Ex: 1234/12345 is accepted
2062/67943 is accepted
372/13333 is not accepted
1234/1234 is not accepted etc...
I tried to put the following in the conditions sheet : <>****/***** and <>????/????? and both did not work (am not sure about the correctness of the approach as am still a beginner in VBA)
For the code itself, this is what I wrote :
Sub GuaranteeElig()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName
Sheets("MainSheet").UsedRange.AdvancedFilter Action:= _
xlFilterCopy,
CriteriaRange:=Sheets("ConditionsSheet").Range("B1:B2"), _
CopyToRange:=Range("A1"), Unique:=False
End Sub
Any tips on how I can do it ?
Thanks in advance :)
As long as the values of the numbers are independent and do not matter, and it is only the Length of the numerical strings that count, you could use a for loop on the cells from the "search" sheet (I assume this is the MainSheet as shown in your code?) where your values are contained.
From there, I'll give you a couple ways to place the data in the validation sheet (assuming this is your ConditionsSheet as shown in your code?) where you are trying to pinpoint the values.
(You may need to change part of your approach depending on how you want the incorrect set of values laid out on your secondary sheet - but this should get you started.) I added a TON of comments as you say you're new to VBA - these will help you understand what is being done.
Sub GuaranteeElig()
'Adding this to help with performance:
Application.ScreenUpdating = False
'Assuming you are adding a sheet here to work with your found criteria.
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ConditionsSheet"
'Using the naming bits below I am assuming the data you are searching for is on MainSheet
'Get used range (most accurate and efficient way I have found yet, others on S.O.
'may have better ways for this - research it if this does not work for you)
'I have had problems using the Sheets().UsedRange method.
Dim c as Long 'This may not be necessary for you if you are looping through only column "A"
Dim r as Long
'Cells(y,x) method uses numerical values for each row (y) or column (x).
c = Cells(1, Columns.Count).End(xlToLeft).Column 'May not be necessary depending on your needs.
'Using this because you have "UsedRange" in your
'code.
'.End(xlToLeft) signifies we are going to the end of the available cell range of
'Row 1 and then performing a "Ctrl+Left Arrow" to skip all blank cells until we hit
'the first non-blank cell.
r = Cells(Rows.Count, 1).End(xlUp).Row
'.End(xlUp) method is similar - we go to the end of the available cell range for the
'column ("A" in this case), then performing a "Ctrl+Up Arrow" to skip all blank cells.
'If you have a header row which spans across the sheet, this is your best option,
'unless you have 'helper' cells which extend beyond the final column of this header
'row. I am assuming Row 1 is a header in this case - change to your needs.
'For your Rows - choose the column which contains congruent data to the bottom of
'your used range - I will assume column 1 in this case - change to suit your needs.
Dim i as long
Dim j as integer
Dim cel as Range
Dim working_Str() as String 'String Array to use later
Dim string1 as String
Dim string2 as String
Dim badString as Boolean
For i = 2 to r Step 1 'Step down from row 2 to the end of data 1 Row at a time
'Row 1 is header.
set cel=Cells(i, 1) 'Sets the cell to check - assuming data is in Column "A"
'i will change from for loop so 'cel' changes from "A2555"
'to "A2554" to "A2553" etc.
working_Str=Split(cel.Value, "/", -1) 'Splits the value based on "/" inside of cel
string1=working_Str(0) 'what we hope will always be 4 digits
string2=working_Str(1) 'what we hope will always be 5 digits
If Len(string1)<>4 Then 'string1 _(xxxx)_(/)(don't care) does not equal 4 digits in length
badString = True
Elseif Len(string2)<>5 Then ''string1 (don't care)(/)_(xxxxx)_ does not equal 5 digits in length
badString = True
End If
If badString Then 'If either strings above were not correct length, then
'We will copy cell value over to the new sheet "ConditionsSheet"
'Comment the next 2 commands to change from going to one row at a time to
'Matching same row/Cell on the 2nd sheet. Change to suit your needs.
j = j + 1 'Counter to move through the cells as you go, only moving one cell
'at a time as you find incorrect values.
Sheets("ConditionsSheet").Range("A" & j).Value=cel.Value 'sets the value on other sheet
'UNComment the next command to change from going to one row at a time to
'matching same row/cell on the 2nd sheet. Change to suit your needs.
'Sheets("ConditionsSheet").Range("A" & i).Value=cel.Value
End if
badString = False 'resets your boolean so it will not fail next check if strings are correct
Next i
'Returning ScreenUpdating back to True to prevent Excel from suppressing screen updates
Application.ScreenUpdating = True
End Sub
UPDATE
Check the beginning and ending lines I just added into the subroutine. Application.ScreenUpdating will suppress or show the changes as they happen - suppressing them makes it go MUCH quicker. You also do not want to leave this setting disabled, as it will prevent Excel from showing updates as you try to work in the cell (like editing cell values, scrolling etc. . . Learned the hard way. . .)
Also, if you have a lot of records in the given row, you could try putting the data into an array first. There is a great example here at this StackOverflow Article.
Accessing the values of a range across multiple rows takes a LOT of bandwidth, so porting the range into an Array first will make this go much quicker, but it still may take a bit. Additionally, how you access the array information will be a little different, but it'll make sense as you research it a little more.
Alternative To VBA
If you want to try using a formula instead, you can use this - just modify for the range you are looking to search. This will potentially take longer depending on processing speed. I am entering the formula on 'Sheet2' and accessing 'Sheet1'
=IF(COUNTIF(Sheet1!A1,"????/?????"),1,0)
You are spot on with the search pattern you want to use, you just need to use a function which uses wildcard characters within an "if" function. What you do with the "If value is true" vs "If value is false" bits are up to you. COUNTIF will parse wildcards, so if it is able to "count" the cell matching this string combination, it will result in a "True" value for your if statement.
Regex method, this will dump the mismatched value in a worksheet named Result, change the input range and worksheet name accordingly.
In my testing, 72k cells in UsedRange takes about 4seconds~:
Option Explicit
Sub GuaranteeElig()
Const outputSheetName As String = "Result"
Dim testValues As Variant
testValues = ThisWorkbook.Worksheets("MainSheet").UsedRange.Value 'Input Range, change accordingly
Const numPattern As String = "[\d]{4}\/[\d]{5}"
Dim regex As Object
Set regex = CreateObject("VBScript.Regexp")
regex.Pattern = numPattern
Dim i As Long
Dim n As Long
Dim failValues As Collection
Set failValues = New Collection
'Loop through all the values and test if it fits the regex pattern - 4 digits + / + 5 digits
'Add the value to failValues collection if it fails the test.
For i = LBound(testValues, 1) To UBound(testValues, 1)
For n = LBound(testValues, 2) To UBound(testValues, 2)
If Not regex.Test(testValues(i, n)) Then failValues.Add testValues(i, n)
Next n
Next i
Erase testValues
Set regex = Nothing
If failValues.Count <> 0 Then
'If there are mismatched value(s) found
'Tranfer the values to an array for easy output later
Dim outputArr() As String
ReDim outputArr(1 To failValues.Count, 1 To 1) As String
For i = 1 To failValues.Count
outputArr(i, 1) = failValues(i)
Next i
'Test if output worksheet exist
Dim outputWS As Worksheet
On Error Resume Next
Set outputWS = ThisWorkbook.Worksheets(outputSheetName)
On Error GoTo 0
'If output worksheet doesn't exist, create a new sheet else clear the first column for array dump
If outputWS Is Nothing Then
Set outputWS = ThisWorkbook.Worksheets.Add
outputWS.Name = outputSheetName
Else
outputWS.Columns(1).Clear
End If
'Dump the array starting from cell A1
outputWS.Cells(1, 1).Resize(UBound(outputArr, 1)).Value = outputArr
Else
MsgBox "No mismatched value found in range"
End If
Set failValues = Nothing
End Sub
If you do not need duplicate values in the list of mismatched (i.e. unique values) then sound out in the comment.
What I am doing is very simple - selecting a union of columns which contain numbers stored as text and converting them. Every time this runs, all even union numbered columns of data are getting cleared.
Union(Columns(19), Columns(22), Columns(25), Columns(28), Columns(31), Columns(34), Columns(37), Columns(40), Columns(43), Columns(46)).Select
With Selection
.Value = .Value
End With
I've looked though my entire code multiple times are cant figure why this is behaving so weird. any help is greatly appreciated.
The Value property of a discontiguous range only returns the first area of that range. When you then try and assign that value (array, in this case) back to a discontiguous range, you get strange results. For this particular case, every second column will get the value of the first cell in the first area.
You should loop through the areas in your range.
For each rArea in Selection.Areas
rarea.value2 = rarea.value2
Next rarea
Try to avoid using Select, and fully qualify your ranges. This makes things easier to diagnose and more robust...
Dim myRange As Range
With ThisWorkbook.Sheets("Sheet1")
Set myRange = Union(.Columns(19), .Columns(22), .Columns(25)) ' etc.
End With
Now if you're trying to convert text to numbers, you might be better off using the NumberFormat property as discussed here: What are .NumberFormat Options In Excel VBA?
Looping through range areas and number-formatting:
Dim area As Range
For Each area In myRange.Areas
area.NumberFormat = 0 ' for numbers, could still use area.Value = area.Value
Next area
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
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, in the past, used a variant array to populate a range of multiple Excel cells.
I'm wondering, is there a way to do the same thing with cell formatting? I'd rather not go cell by cell, and it'd be nice to minimize the number of calls to get an Excel range...
I mostly do what Lance suggests. However, there are some cases where I will make a separate, hidden worksheet with the formats I want set up. Then I'll
wshHidden.Range("A1:D100").Copy
wshReport.Range("A1:D100").PasteSpecial xlPasteFormats
That takes care of it in one fell swoop. But you do have the overhead of the hidden sheet.
#ExcelHero has pointed out to me how to get this done, so here's how.
If your range is horizontal, then just feed it an array built of Format strings:
[a1:c1].NumberFormat = Array("hh:mm", "General", "$#,##0.00")
If your range is vertical, then transpose that array, since Excel considers Arrays to be horizontal:
[a1:a3].NumberFormat = WorksheetFunction.Transpose(Array("hh:mm", "General", "$#,##0.00"))
Old Answer:
No, you can't do each cell separately, though you can bulk assign one format to an entire range.
The property of a Range to assign to is .NumberFormat. If you create a variant array of strings to assign as a format, then assign it to the range, only the first element gets applied (and it gets applied to all cells of the range).
So the best you can do is loop:
Dim r As Range
Dim v(1 To 3) As Variant
Dim i As Integer
Set r = Range("A1:A3")
v(1) = "hh:mm:ss"
v(2) = "General"
v(3) = "$#,##0.00_);[Red]($#,##0.00)"
For i = 1 to 3
r(i).NumberFormat = v(i)
Next i
Hopefully I can safely presume you are doing this for performance reasons. As answered above, its not really possible the same way you can do with cell contents.
However, if the formatting of cells is often the same as last time you formatted it, it is much faster to first check if the format needs to change, and only then change it.
Here is a function that can do it. In tests (Excel 2003), this runs 8x-10x faster than always setting the format, and that is with screen updating turned off.
Sub SetProperty(ByRef obj As Object, propname, newvalue)
If CallByName(obj, propname, VbGet) <> newvalue Then
Call CallByName(obj, propname, VbLet, newvalue)
End If
End Sub
Call it like this:
Call SetProperty(Cells(1,1).Font, "ColorIndex", 27)
Call SetProperty(Cells(1,1).Borders, "Weight", xlMedium)
etc