My below code only gives output for 2 rows, rest it is not getting applied don't know why? formula needs to applied from K20 till last row of adjacent column(J) . Can someone help me in correcting it. Thanks!
Sub SortS()
Range("K19").Select
ActiveCell.FormulaR1C1 = "Sort"
With Sheets("Sheet1")
rowlast = .Range("K" & .Rows.Count).End(xlUp).Row
With .Range("K20:K" & rowlast)
.Formula = "=IF(COUNTIF(RC[-6]:RC[-2],""S"")>0,1,0)"
.Value = .Value
End With
End With
End Sub
You're not looking at column J for the last row - try changing this
rowlast = .Range("K" & .Rows.Count).End(xlUp).Row
to this
rowlast = .Range("J" & .Rows.Count).End(xlUp).Row
Related
I'm updating a report everyday and adding data from yesterdays runs. I would like to insert a code in the macro to add the date into column A next to the newly added data without changing the previous dates already in column A.
Sub datedd()
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
With Range("A2:A" & lastRow)
.Value = Now -1
.NumberFormat = "mm/dd/yy"
End With
End Sub
But this changes all the dates in column A
not sure why pasting in the code breaks apart like this, sorry im new here!
Sub datedd()
Dim lastRow As Long
Dim firstRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
firstRow = Range("A" & Rows.Count).End(xlUp).Row + 1
With Range("A" & CStr(firstRow) & ":A" & CStr(lastRow))
.Value = Now -1
.NumberFormat = "mm/dd/yy"
End With
End Sub
I tried using the code below but it display the entire row in the new sheet. Is there a way that i can move only specific columns to the new sheet by modifying the vba macro code below?
Thanks in advance!
Sub CopyExpired()
Dim bottomB As Integer
bottomB = Sheets("sheet1").Range("B" & Rows.Count).End(xlUp).Row
Dim c As Range
For Each c In Sheets("sheet1").Range("B1:B" & bottomB)
If c.Value = "expired" Then
c.EntireRow.Copy Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next c
End Sub
Try to use an .AutoFilter.
Sub CopyExpired()
With Worksheets("sheet1")
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, "A").CurrentRegion
.AutoFilter field:=2, Criteria1:="expired"
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
Replace
c.EntireRow.Copy
with
Range("C" & c.Row & ",E" & c.Row & ",H" & c.Row).Copy
and you can select what columns to use
if I didnt do the syntax 100% right then sorry. Dont have excel near me.
1st: please dont use A1 codes in your macros. Rather use the R1C1 method as follows:
dim sh as worksheet
set sh =activeworkbook.activesheet
sh.cells(1,2) = "Test worked!!"
'this will put the text into row 1 column 2 of your sheet.
2nd: you could copy each cell via a subroutine.
for example:
dim rw1 as integer, lastRw as integer, cellsToRight as integer
lastRw = sh.UsedRange.SpecialCells(xlCellTypeLastCell).Row
for rw1 = 1 to lrw
for col=1 to 10
sh.cells(rw1,col + cellstoright)=sh.cells(rw1,col)
next col
next rw1
or you could just do the colums yourself manualls, eg... array of integer with the values 1,3,4,6,7,8 ... and then loop over the array with your integers as columns, same thing as the above loops.
Sub CHECKas()
Dim lastrow As Long
Dim lastcol As Long
Dim l As Integer
Dim i As Integer
Dim rname As Constants
Set rngTarg = Selection
lastrow = Sheets("report").Range("B" & Rows.Count).End(xlUp).row
lastcol = Sheets("report").Cells(2, Columns.Count).End(xlToLeft).Column
Sheets("FEBBRAIO").Select
ActiveCell.Offset(0, -3).Copy
Sheets("REPORT").Select
Cells(1, lastcol + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
rname = Application.ActiveCell.Value
ActiveCell.Offset(1, 0).Select
For i = 2 To lastrow
ThisWorkbook.Sheets("report").Select
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
Next i
End Sub
I'm new in VBA and I can't understand how to compare a constant value with each cell in a range("g2:g" & lastrow) and ("f2:f" & lastrow). The constant value is an active cell in my case. For example considering this formula: IF(AND($R$1<G2;$R$1>=f2);1;0 where R$1$ is the active cell of the last not empty column in ROW 1. I need to fill the entire column (that is activecell.column) with the output coming out form this formula.
But the I Got mismatch error in:
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
I know from the previous question that this error occurs because I'm trying to comparing a single value against an array of values. How can fix this problem?
You have to use
Range("F" & i)
in your code. Same thing applies to other instances of such code.
Sorry if this is simple, this is my first time trying VBA.
So I want this macro to get rid of rows I don't need, and for every entity it has a total field (about every 20 records or so) and I made this script:
Dim i As Integer
Dim LastRow As Integer
LastRow = Range("A65536").End(xlUp).Row
For i = 3 To LastRow
If Range("C" & i) = "Result" Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=x1Up
End If
Next
And that worked perfectly! Then I tried to a similar thing.. I tried to go through each row (record) in a data set and then if a certain field does not contain the string "INVOICE" then I don't need that row and I can delete it. So I just added into my current loop (why loop twice?) So now it looks like this:
Dim i As Integer
Dim LastRow As Integer
LastRow = Range("A65536").End(xlUp).Row
For i = 3 To LastRow
If Range("C" & i) = "Result" Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=x1Up
End If
If Not InStr(1, Range("Q" & i), "INVOICE") Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=x1Up
End If
Next
That second bit as far as I can tell just randomly starts deleting rows with no rhyme or reason. Rows where the Q field doesn't contain invoice sometimes stay sometimes go, and same if it does contain invoice. Any idea what I'm doing wrong?
You should OR your conditions together so that if either reason exists the line is deleted. Otherwise since you're deleting lines within a preset range, you'll end up skipping more lines than you are currently. Currently it looks like you skip a line everytime you delete one, so you're missing any consecutive cases. Tim's advice to work from the last row up is spot on.
For i = LastRow to 3 Step -1
If Range("C" & i) = "Result" OR Not InStr(1, Range("Q" & i), "INVOICE") Then
Rows(i & ":" i).Delete Shift:=x1Up
End If
Next i
There are indeed two approaches: AutoFilter and For Loop. Of the two, AutoFilter is much faster especially with large datasets, but it will often need a very good set-up. The For Loop is easy, but it has marginal returns, especially when your data start hitting 100k rows or more.
Also, Not InStr(1, Range("Q" & i), "INVOICE") might seem like the best way but IMHO it's not. InStr returns a number, so it's better if you either do further comparison like Not InStr(1, Range("Q" & i), "INVOICE") > 0 or just simply InStr(1, Range("Q" & i), "INVOICE") = 0. In any case, I used the former in my second code below.
Following are both approaches. They are tested on simple data. The code might seem a bit bulky, but the logic is sound. Refer to the comments as well for other things.
AutoFilter approach:
Sub RemoveViaFilter()
Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("ModifyMe")
Dim LastRow As Long
Application.ScreenUpdating = False
With WS
'--For condition "Result"
.AutoFilterMode = False
LastRow = .Cells(Rows.Count, 1).End(xlUp).row '--Compatible if there are more rows.
With Range("A2:Q" & LastRow) '--Assuming your header is in Row 2 and records start at Row 3.
.AutoFilter Field:=3, Criteria1:="Result" '--Field:=3 is Column C if data starts at A
.Cells.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete '--Delete the visible ones.
End With
'--For condition "<>*INVOICE*"
.AutoFilterMode = False
LastRow = .Cells(Rows.Count, 1).End(xlUp).row
With Range("A2:Q" & LastRow)
.AutoFilter Field:=17, Criteria1:="<>*INVOICE*" '--Field:=17 is Column Q if data starts at A
.Cells.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
For-loop approach:
Sub RemoveViaLoop()
Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("Sheet6")
Dim LastRow As Long: LastRow = WS.Cells(Rows.Count, 1).End(xlUp).row
Dim Iter As Long
Application.ScreenUpdating = False
With WS
For Iter = LastRow To 3 Step -1 '--Move through the rows from bottom to up by 1 step (row) at a time.
If .Range("C" & Iter) = "Result" Or Not InStr(1, .Range("Q" & Iter).Value, "Invoice") > 0 Then
.Rows(Iter).EntireRow.Delete
End If
Next Iter
End With
Application.ScreenUpdating = True
End Sub
Let us know if this helps.
I know we can get the last row with data with following code:
LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
But I am having trouble on getting the last Column with data. Here is what i tried bu as you can see from the image it didn't go through
Set ws = ThisWorkbook.ActiveSheet
With ws
Header = 5
LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
LastCol = .Range(5 & .ColumnCount).End(xlLeft).Column
With .Range("A" & Header & LastCol & LastRow)
.Interior.ColorIndex = 16
End With
End With
Can you please let me know hoe I can fix this? thanks
Try this as i've commented:
Lastcol = .Cells(5, Columns.Count).End(xlToLeft).Column
i'm not sure if its xlLeft or xlToLeft. Try it yourself.
Use this to color the entire range:
With .Range(Cells(1,5),Cells(Lastrow,Lastcol)
.Interior.ColorIndex = 16
End With
this colors A5 to your last column and row.