I have large table with values in range H2:PIG2202. I need to compare the first rows H2:PIG2 values with all other rows values. And if there is a match in the result table it pastes just those values which matched.
Now I'm using this formula in the result table to display needed values:
=IF(sheet!H$2=sheet!H3;IF(AND(sheet!H3;ISBLANK(sheet!H3))=FALSE;sheet!H3;"");"")
The VBA code is:
Sub find()
Application.ScreenUpdating = False
Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Application.ScreenUpdating = True
End Sub
The problem is that Excel shows an error when I run this macros that there are not enough system resources.
Also I would like that in the result table would be just values, not formulas.
Is that possible to do? I have no idea how to achieve this :(
Thank you in advance!
Quick solution for your which is not sophisticated and I'm rather not proud of it (but it was quickest to prepare). Keep in mind that you are going to run it 24m times which could take several minutes, maybe an hour. Some comments inside the code.
Sub Solution()
Application.ScreenUpdating = False
'-----previous one
'Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
'----- new one- inserting values- first idea, simple code
Dim Cell As Range
'run for one row first to check if it is ok! and check time needed per row
'next change range to one you expect
'next- take a cup of coffee and relax...
For Each Cell In Range("h2:PIG2")
Cell.FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Cell.Value = Cell.Value
'to trace progress in Excel status bar
Application.StatusBar = Cell.Address
Next Cell
Application.ScreenUpdating = True
End Sub
Related
I've searched and searched the internet and all of the forums and I've been piecing together code and still can't figure this out. I've tried For loops and For Each loops and still can't get it right. In my sheet, I have all of my dates in Column D. I want to hide rows by month. I want to be able to click a macro button and only show dates in January, or February, or etc.
This is what I currently have:
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
End If
If cell.Value < "1/1/2018" Or cell.Value > "1/31/2018" Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
When I run this, it just hides anything that isn't an empty cell. I've cycled between defining cell as a Range and as a Variant and it's the same either way.
ETA:
It is working now and it took help from everybody. I really appreciate it! Here's what I ended with..
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
ElseIf cell.Value < CDate("1/1") Or cell.Value > CDate("1/31") Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
I removed the years from the code so that I don't have to change any coding for future years.
Your current setup would qualify all dates as either < or > the respective date comparison.
If you are trying to hide rows for January in this code, then you need to use AND instead of OR
And be sure you use >= & <= to include those first and last dates.
If cell >= "1/1/2018" AND cell <= "1/31/2018" Then
If you are trying to hide rows not January then your < and > are transposed:
If cell < "1/1/2018" OR cell > "1/31/2018" Then
Alternative approach: If you've got Excel 2013 or later, simply add a Table Slicer and filter on a MONTH column generated with =DATE(YEAR([#Date]),MONTH([#Date]),1) as shown below:
Or otherwise use a PivotTable and a Slicer:
To see how easy it is to set up a PivotTable, see VBA to copy data if multiple criteria are met
Ultimately, I believe this is the code you're looking for:
Sub January()
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Date")
'If date falls on or after January 1, AND on or before January 31, don't hide the row
If cell.Value >= CDate("1/1/2018") And cell.Value <= CDate("1/31/2018") Then
cell.EntireRow.Hidden = False
Else
'If the cell doesn't contain anything or isn't in January, hide the row
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
End Sub
You need to use And logic, not Or logic. Or logic always returns TRUE unless both expressions are false or there is a null involved. Because of this, the code stopped looking at your logical statement once it evaluated to true since every date you had - I'm assuming - fell after January 1, 2018. This in turn caused the rows to hide unexpectedly.
Additionally, I would convert the strings you have into dates using CDate. It helps Excel understand what is going on a bit better and makes your code easier to understand to outsiders. Another good practice to work on is adding comments to code. I think we've all learned the hard way by leaving comments out of code at some point or another.
One last thing: if you're planning to have buttons for each month, consider doing one procedure for all of them and having variables populate the date ranges, potentially using input boxes to get the values from the user. It'll save you a lot of headaches if you ever decide to change things up in the future.
Untested, written on mobile. I am just providing an alternative approach which tries to use MONTH and YEAR. Some may find this approach easier to understand.
Option Explicit
Sub January()
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = (Month(cell.Value) = 1) and (year(cell.Value) = 2018)
End if
Next cell
End sub
I will actually go with Slicers and Table.
But if you call VBA your neat solution then I'd say abandon the loop.
Have nothing against it but if Excel already have the functionality, then use it.
It is like a discount or a promotion that we need to take advantage of.
So instead of loop, why not just filter?
Dim lr As Long, r As Range
With Sheet1 '/* sheet where data reside */
.AutoFilterMode = False '/* reset any filtering already applied */
lr = .Range("D" & .Rows.Count).End(xlUp).Row '/* get the target cells */
Set r = .Range("D1:D" & lr) '/* explicitly set target object */
'/* filter without showing the dropdown, see the last argument set to false */
r.AutoFilter 1, ">=2/1/2018", xlAnd, "<=2/28/2018", False
End With
Above is for February of this year, you can tweak it to be dynamic.
You can create separate sub procedure for each month of you can just have a generic one.
In excel on a single sheet, I have a blank template and a set of raw data on the side which needs to be inserted into the template. I need help creating the VBA code to copy and paste the data into the template with it not pasting any extra cells (stop at the end of the data). My raw data changes and should be able to be any length of rows but it is always constant from columns Z:AL. I am interesting in moving it to columns A5:M5.
Thanks in advance!
This is the simplest code I can think of. You might want to throw a worksheet reference in front of the Range and I included a couple of methods of finding the end of the range. I prefer the 3rd method.
dest = "A5"
wsName = "DataSheet"
With Worksheets(wsName)
endRow1 = .Range("Z1").End(xlDown).Row
endRow2 = .Range("Z105000").End(xlUp).Row
endRow3 = .Range("Z:AL").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("Z1:AL" & endRow3).Copy Destination:=Range(dest)
End With
If there are not blanks in a column in the dataset (I assume column Z) then you can use Range.End to get the last row. I try to avoid using Copy/Paste in macros, because there's a faster way to do it.
Option Explicit
Sub MoveDataRange()
Dim dest As Range, endRow As Integer
With Worksheets("DataSheet")
endRow = .Range("Z1").End(xlDown).Row
Set dest = .Range("A5").Resize(endRow, 13) '13 columns between Z:AL
dest.Value = .Range("Z1:AL" & endRow).Value
End With
End Sub
I wrote a very simple macro in Excel to remove some trailing excessive text. here is the code:
Sub remove_excess_names_from_part_number()
Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 1000
Cells(i, 3).Value = Left(Cells(i, 3).Value, 10)
Next i
Application.ScreenUpdating = True
End Sub
I cannot see how this can get any simpler and yet I am disappointed by the poor Performance of this code snippet. Doesn't VBA make some optimizations for simple code like that?
Try below code :
Column C is result Column and data is in Column A
Sub remove_excess_names_from_part_number()
Application.ScreenUpdating = False
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("C1:C" & lastRow).FormulaR1C1 = "=Left(RC[-2],10)"
Application.ScreenUpdating = True
End Sub
Do you really need VBA for this? If you want you can use Excel's Text To Columns
Let's say the data is like this in Excel
Select your column and Click on Data | Text To Columns
Select Fixed Width in Step 1 of 3
Set your length in Step 2 of 3. If you see below, I have set it for 10
Click Finish and you are done.
Note: If the 10th character is a SPACE then it will be truncated as in Row 2
If you still want a VBA solution then I would recommend loading the entire range in an Array as #assylias suggested and then put it back after performing the calculations.
#Santosh has also given you a suggestion when you can enter the formula in one go to all the cells. If Non VBA option is available to you then you can enter the formula in the cell manually and do an autofill as well :)
I have an interesting issue. I've tried searching this site and Google but there are only slightly related problems, none which actually address this specific need.
I have a spreadsheet with 10 columns (let's call them A-J). I need to delete all the rows that do NOT have a value of "30", "60", "90", "120" or blank within the cells of column H.
Though there are many ways of doing this, all of them have relied on loops, which doesn't work for me as this dataset has over 25k rows and it takes 10+ minutes to run - too long.
I've been looking at autofilter options in conjunction with the .Find function (e.g. find all rows with H cells that don't meet the criteria and delete) but AutoFilter on 2003 only works with 2 criteria, while I have 5 to check against. I'm not sure how to proceed.
Any help is appreciated.
This deleted all matching rows (~10%) in a sample of 25k rows in 20sec
Sub tt()
Dim rw As Range
Dim all As Range
Dim t
Dim b As Boolean
t = Timer
For Each rw In Range("A1").CurrentRegion.Rows
If rw.Cells(8).Value < 1 Then
If b Then
Set all = Application.Union(rw, all)
Else
Set all = rw
b = True
End If
End If
Next rw
If not all is nothing then all.EntireRow.Delete
Debug.Print "elapsed: " & Timer - t
End Sub
You can try Advanced Filter option where you can give more than two criteria to filter the list. After filtering the list matching the criteria you set, the filtered list can be copied to another location (option available) and the remaining deleted.
You can add a column with the condition of your own:
=IF(OR(H1=30;H1=60;H1=90;H1=120;H1="");"DELETE";"")
(the formula is given for row 1, you have to copy-paste it to the entire range)
Then use filtering and sorting to select the rows to delete.
Some speed tips:
When using large data, assign values to array and use array instead of *.Value;
When working with full columns, ignore empty columns at bottom;
When making intensive changes in worksheet, disable screen update and automatic calculation.
Stating this, I would use this code:
Sub Macro1()
Dim su As Boolean, cm As XlCalculation
Dim r As Long, v(), r_offset As Long
su = Application.ScreenUpdating
Application.ScreenUpdating = False 'Disable screen updating
cm = Application.Calculation
Application.Calculation = xlCalculationManual 'Disable automatic calculation
'Only use used values
With Intersect(Range("H:H"), Range("H:H").Worksheet.UsedRange)
v = .Value 'Assign values to array
r_offset = .Row - LBound(v) 'Mapping between array first index and worksheet row number
End With
'Check all row from bottom (so don't need to deal with row number changes after deletion)
For r = UBound(v) To LBound(v) Step -1
Select Case v(r, 1)
Case "30", "60", "90", "120", Empty 'Do nothing
Case Else
Sheet1.Rows(r + r_offset).EntireRow.Delete
End Select
Next
Application.ScreenUpdating = su 'Restore screen updating
Application.Calculation = cm 'Restore calculation mode
End Sub
Thanks to all who've suggested solutions. In the between time I ended up figuring out a way to do this in <1 second - apparently I myself didn't realise that AutoFilter could've supported comparison criteria (greater than, less than etc).
Using a series of autofilters I simply filtered for, then deleted all rows that filtered to "<30", "30120".
Not elegant, but it did the trick.
I have a fairly simple syntax question:
I'm trying to copy and paste n rows from one excel file to another. In addition, I'd like to store the total copied rows into a variable.
Can someone help me accomplish this?
For example:
1)
Activate CSV file
Apply Filter to Column B (Page Title) & uncheck "blanks" ("<>") filter**
Windows("Test_Origin.xlsm").Activate
ActiveSheet.Range("$A$1:$J$206").AutoFilter Field:=2, Criteria1:="<>"
2)
Copy Filtered Lines with data (Excluding Row 1)
Range("B2:F189").Select
Selection.Copy
copiedRowTotal = total *FILTERED* rows copied over from original sheet, then Test Number iterates that many times
copiedRowTotal = Selection.Rows.Count
MsgBox copiedRowTotal
Thanks
An indirect way to do this is
Range("B2:F189").Copy
Range("M2").PasteSpecial xlPasteValues
copiedRowTotal = Selection.Rows.Count
Selection.Clear
The code copies the range & does a paste special operation on a separate location.
By doing this, only filtered rows are copied to M2 & the area (where the filtered rows are pasted) is highlighted when PasteSpecial operation is done.
Doing a Selection.Rows.Count gives one, the number of filtered rows that were pasted.
After figuring out the number of filtered rows, the selection is cleared up.
I don't believe there is a way to get the visible cell count directly. I tried using the 'SpecialCells(xlSpecialCellsVisible)' function, but could not get the correct count with a filter applied. Here is a quick function I wrote that works with a filter applied.
Also be aware that sometimes a filter can mess with the selected range at times, so it's something to note.
Public Sub TestIt()
Dim visibleCount As Long
visibleCount = GetVisibleCount(Sheets(1).Range("A2:H3000"))
MsgBox visibleCount
End Sub
Public Function GetVisibleCount(rng As Range) As Long
Dim loopRow As Range
GetVisibleCount = 0
For Each loopRow In rng.Rows
If loopRow.Hidden = False Then
GetVisibleCount = GetVisibleCount + 1
End If
Next loopRow
End Function
copiedrowtotal = selection.rows.count ' its not selection.totalcells
I think this would do the trick
After seeing your update let me tell you probably these would work
dim i as long
i = Application.WorksheetFunction.Subtotal(2,worksheets("Sheet").Range("B2:F189"))
Now i has the number of filtered rows in it! If you have included header in your range then do -1 at the end else just leave it up
argument 2 in subtotal is => counting the rows and then sheet name
and then specify range to count filtered rows
instead I would select only one column if you applied filter for many columns!
Hope it helps dont forget to accept an answer ! :