I have inherited a very large spreadsheet and am trying to migrate it to a database. The table has over 300 columns, many of which reference other columns.
By converting it to a table (ListObject) in Excel, I thought it would be easier to deconstruct the logic... basically turn the formula:
=CJ6-CY6
into
=[#[Sale Price]]-[#[Standard Cost]]
Converting it to a table worked great... unfortunately it didn't change any of the embedded formulas. They still reference the ranges.
I think I may notionally understand why -- if a formula references a value in another row, then it's no longer a primitive calculation. But for formulas that are all on the same row, I'm wondering if there is any way to convert them without manually going into each of these 300+ columns and re-writing them. Some of them are beastly. No joke, this is an example:
=IF(IF(IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))<0,0,IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6))))>GO6,GO6,IF(IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))<0,0,IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))))
And it's not the worst one.
If anyone has ideas, I'd welcome them. I'm open to anything. VBA included.
I would never use this to teach computer science, but this is the hack that did the trick. To keep things simple, I transposed header names and the corresponding column into A17:
And then this VBA code successfully transformed each range into the corresponding column property.
Sub FooBomb()
Dim ws As Worksheet
Dim r, rw, translate As Range
Dim col, row As Integer
Dim find, anchored, repl As String
Set ws = ActiveWorkbook.ActiveSheet
Set rw = ws.Rows(6)
Set translate = ws.Range("A17:B363")
For col = 12 To 347
Set r = rw.Cells(1, col)
For row = 363 To 17 Step -1
find = ws.Cells(row, 1).Value2 & "6"
anchored = "$" & find
repl = "[#[" & ws.Cells(row, 2).Value2 & "]]"
r.Formula = VBA.Replace(r.Formula, anchored, repl)
r.Formula = VBA.Replace(r.Formula, find, repl)
Next row
Next col
End Sub
Hard-coded and not scalable, but I'm not looking to repeat this ever again.
-- EDIT --
Word to the wise to help performance, especially with as many columns and formulas are in this spreadsheet.
Set Formula calculation to manual before
Check before the field exists before doing a replacement -- skipping happens more often than not
Program ran in a few seconds (minutes prior) before these changes:
If InStr(r.Formula, anchored) > 0 Then
r.Formula = VBA.Replace(r.Formula, anchored, repl)
End If
If InStr(r.Formula, find) > 0 Then
r.Formula = VBA.Replace(r.Formula, find, repl)
End If
Related
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)
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.
I have some larger files I need to validate the data in. I have most of it automated to input the formulas I need automatically. This helps eliminate errors of copy and paste on large files. The problem is with this latest validation.
One of the latest validations involves counting the number of rows that match 3 columns. The 3 columns are in Sheet 2 and the rows to count are in Sheet 1. Then compare this count with an expected number based on Sheet 2. It is easy enough to do with CountIFs, but there are large files and it can take up to an hour on some of them. I am trying to find something faster.
I am using a smaller file and it is still taking about 1 minute. There are only about 1800 rows.
I have something like this:
In Check1 I am using: =COUNTIFS(Sheet1!A:A,A2,Sheet1!B:B,B2,Sheet1!C:C,C2)
My code puts that formula in the active cell. Is there a better way to do this?
Is there anyway - using VB or anything - to improve the performance.
When the rows start getting into the 10's of thousands it is time to start this and get lunch. And, then hope it is done when I get back to my desk!
Thanks.
You basically have to iterate over all rows for each column, this is expensive. You might be able to split this into two tasks:
Merge your Columns A-C into one value =CONCAT(A2,B2,C2)
Then do only a single countif on this column =COUNTIF(D:D,D2)
That way you get rid of two (time) expensive countifs at the cost of the new concat.
You should narrow the range CountIf acts on from entire columns to the actual used range
And your code could write the result of the formula instead of the formula itself
Like follows:
With Sheet1
Set sheet1Rng = Intersect(.UsedRange, .Range("A:C"))
End With
With Sheet2
For Each cell in Intersect(.UsedRange, .Range("A:A"))
cell.Offset(,3) = WorksheetFunction.CountIfs(sheet1Rng.Columns(1), cell.Value, sheet1Rng.Columns(2), cell.Offset(,1).Value, sheet1Rng.Columns(3),cell.Offset(2).Value)
Next cell
End With
I set up a mock sheet, using a layout similar to what you show, with 10,000 rows, and manually filled it with the COUNTIFS formula you show. Changing a single item in the data triggered a recalculation which took about ten seconds or so to execute.
I then tried the following macro, which executed in well under one second. All of the counting is done within the VBA macro. So this Dictionary method may be an answer to your speed problems.
Before running this, you may want to set the Calculation state to Manual (or do it in the code) if you have COUNTIFS on the worksheet.
Option Explicit
'set reference to Microsoft Scripting Runtime
Sub CountCol123()
Dim DCT As Dictionary
Dim V As Variant
Dim WS As Worksheet, R As Range
Dim I As Long
Dim sKey As String
Set WS = Worksheets("sheet2")
'read the info into an array
With WS
Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=4)
V = R
End With
'Get count of the matches
Set DCT = New Dictionary
For I = 2 To UBound(V, 1)
sKey = V(I, 1) & "|" & V(I, 2) & "|" & V(I, 3)
If DCT.Exists(sKey) Then
DCT(sKey) = DCT(sKey) + 1
Else
DCT.Add Key:=sKey, Item:=1
End If
Next I
'Get the results and write them out
For I = 2 To UBound(V, 1)
sKey = V(I, 1) & "|" & V(I, 2) & "|" & V(I, 3)
V(I, 4) = DCT(sKey)
Next I
'If you have COUNTIFS on the worksheet when testing this,
' or any other formulas that will be triggered,
' then uncomment the next line
'Application.Calculation = xlCalculationManual
With R
.EntireColumn.Clear
.Value = V
End With
End Sub
The Excel alternative named Cell in Hancom Office 2020 is insanely fast at countifs. Not sure why. On my i7-5775C, Excel 2019 takes 90 seconds for a countifs with two criteria for populating 10,000 rows with the results. Using Cell, the exact same operation completes in less than 28 seconds. I have verified that the results match those generated by Excel 2019.
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.
I have a downloaded bank statement on SHEET1 (ALL).
I have several widgets running along the side one of which
=SUMIF(C:C,H3,D:D)
Searches the Descriptions for the value in H3 (EG: * WAGES *) and totals up the corresponding value in D.
I now need to expand that so that it copies the entire ROW onto a new Spreadsheet.
I'd also like, if possible, to start with an input box so I can search for multiple things at once.
Various code that I have seen / tried will only work for exact values in Row C. But with the bank statement its never the same twice and I'd like it to wildcard the search if possible.
Thanks for your time.
Kind Regards
Alex Nicol
I have recently written VBA code just like this. Where I use the word payments, you can use the word Wages and include your wildcards like so:
a.Cells(b.Row, 16).Value LIKE "*Wages*"
Sub ShortTerm()
Dim a As Range, b As Range
Dim i As Long
Dim j As Long
Dim p As Long
Dim value1 As Variant
i = 4 'the start row for pasting
Set a = ThisWorkbook.Sheets("Payments").UsedRange
For Each b In a.Rows
'in the next line change 16 to reflect the column where WAGES is found
If a.Cells(b.Row, 16).Value = "Short Term" Then
For j = 1 to 16
value1 = a.Cells(b.Row, j).Value
ThisWorkbook.Sheets("DestinationSheet").Cells(i, j).Value = value1
Next
i = i + 1
End If
Next
End Sub
Obviously I am only copying 16 columns and so if that is all you want, this should work. If you need more, make that loop larger. There is probably a way to copy the whole row, but I had originally only wanted specific cells and I had wanted them reorganized which is why I did it the way I did.
See the post on my blog here:
http://automatic-office.com/?p=355