I have the same dates and times in two columns. Now I want to loop through the dates and times of the second column and count how many items in the first column ("A1:A10") are greater than the respective date and time in the loop. But the count is always zero ("C1:C10").
CountIf with dates and times
Sub countif_datetime()
Dim sheet1 As Worksheet
Dim my_range As Range
Dim i As Integer
Set sheet1 = Worksheets("Sheet1")
Set my_range = sheet1.Range("A1:A10")
For i = 1 To 10
sheet1.Cells(i, 3).Value = WorksheetFunction.CountIf( _
my_range, ">" & sheet1.Cells(i, 2).Value _
)
Next i
End Sub
When I use the same function (countif) in the worksheet ("D1:D10") the count is there.
I also tried to convert the dates to double and it did not work either.
I can't reproduce your error at my end, i.e. your code works for me
but since the formula works at your end, you could consider a formula approach
Sub countif_datetime()
With Worksheets("Sheet1")
With .Range("A1:A10").Offset(, 2)
.FormulaR1C1 = "=COUNTIF(R1C1:R10C1,"">"" & RC[-1])"
.Value = .Value ' turn formulas into values
End With
End With
End sub
or, with a slightly more general approach:
With Worksheets("Sheet1")
With .Range("A1:A10").Offset(, 2)
Dim firstRow As Long, _
lastRow As Long
firstRow = .Rows(1).Row
lastRow = .Rows(.Rows.Count).Row
.FormulaR1C1 = "=COUNTIF(R" & firstRow & "C1:R" & lastRow & "C1,"">"" & RC[-1])"
.Value = .Value
End With
End With
Related
[Copy A2 to E2 till the end of row of the table and check if the cell is within the same month](https://i.stack.imgur.com/Q7YAx.png)
Hi,
I would like to loop through rows from a sheet table from column A2 to E2 to A3 to E3... till the end of the table Ai to Ei by defining a variable and counting the last row of the table.
As the second step, I would like to copy the cells into another sheet and fill it the corresponding months.
[Desired Output--> it will copy the data and return to another sheet in the corresponding month] (https://i.stack.imgur.com/zhgYh.png)
Instead, I've changed the data type into a number format and have set up two condition to loop through.
eg. 1/1/2017 change to 42736
28/2/2017 change to 42794
Sub Mike_Copy_cell()
Dim i As Long 'for looping inside each cell
Dim myvalue As Variant
Dim Lastrow As Long
Const StartRow As Byte = 2
Dim LastMonth As Long
("Mike Filter").Select
Lastrow = Range("A" & StartRow).End(xlDown).Row
For i = StartRow To Lastrow
myvalue = Range("H" & i).Value
If myvalue \< Sheets("Automate Report").Range("A" & i).Value \_
'First data Feb Data 42794 \< Jan Category 42736
Then Sheets("Automate Report").Range("B" & i).Value = ""
'leave the cells in blanks and loop through next cell
If myvalue > Sheets("Automate Report").Range("A" & i).Value _
'First data Feb Data 42794 > Jan Category 42736
Then Range("A" & i, "E" & i).Copy Sheets("Automate Report").Range("B" & i, "F" & i)
'Copy the cells into corresponding category
Next i
End sub()
In my output, it is able to loop through and copy all the cells. However, I am wondering the reason why VBA output is not able leave any blank cells when the first condition is met ?
**I am expecting some blanks in the table if it is not data is not within the same month or in my case is less than criteria I have set. **
The output of my code
If myvalue < Sheets("Automate Report").Range("A" & i).Value _
Then Sheets("Automate Report").Range("B" & i).Value = ""
Greatly appreciate if you can advise the flaws in my code. Massive Thanks.
Best regards,
Kenneth
I'll try to help. But before, may I give you two suggestions that might help you?
First, for me the best way to find the last row is, instead of using xldown from the first row, using xlup from the very last row of excel. This way, if there is a blank in any middle row, the code still gives you the last row with value.
Second, I found that referring to any cells with the "range" method may limit you sometimes when using variables in this reference. I think using the "cells(row, column)" method is more useful.
Why not trying this?
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Sorry for the suggestions, It's just that I wish someone had taught them to me sooner.
Back to the topic, I think the problem is how you structure the "if" statement. Allow me to change it a bit:
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = StartRow To Lastrow
myvalue = cells(i, 8).Value
'if myvalue date is equal or previous to the one found in Ai...
If myvalue <= Sheets("Automate Report").cells(i, 1).Value then
Sheets("Automate Report").cells(i, 2).Value = ""
'but if myvalue is later than Ai...
else
sheets("Automate Report").select
range(cells(i, 1), cells(i, 5).select
selection.copy
cells(i, 2).select
activesheet.paste
end if
Next i
Hope this helps. Best regards,
Mike
I'm not sure what your code is doing but consider using an array(12) of row numbers, one for each month. Copy lines into corresponding month and increment the row number for that month. For example ;
Option Explicit
Sub Mike_Copy_cell()
Const LINES_MTH = 5 ' lines per month
Dim wb As Workbook
Dim wsIn As Worksheet, wsOut As Worksheet
Dim lastrow As Long, rIn As Long, rOut(12) As Long
Dim uid As String, prevuid As String
Dim dAVD As Date, m As Long, n As Long
Set wb = ThisWorkbook
Set wsIn = wb.Sheets("Mike Filter")
Set wsOut = wb.Sheets("Automate Report")
' space out months
For n = 0 To 11
rOut(n + 1) = 2 + n * LINES_MTH
wsOut.Cells(rOut(n + 1), "A").Value2 = MonthName(n + 1)
Next
n = 0
With wsIn
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For rIn = 2 To lastrow
dAVD = .Cells(rIn, "D")
' create a unique ID to skip duplicates
uid = .Cells(rIn, "A") & Format(.Cells(rIn, "D"), "YYYY-MM-DD")
If uid <> prevuid Then
m = Month(dAVD)
.Cells(rIn, "A").Resize(, 5).Copy wsOut.Cells(rOut(m), "B")
rOut(m) = rOut(m) + 1
n = n + 1
End If
prevuid = uid
Next
End With
MsgBox n & " lines copied to " & wsOut.Name, vbInformation
End Sub
I have the below code where in all other columns there is many populated rows, what I need this formula to do in column F is to find the first blank, then place the formula in it and fill it down to the last row.
What is currently happening is I have the range as F26 as this is usually first blank but this could change and I want the code to identify this and also have the formula dynamically know what row it is on, so for example if one month the first blank was in cell F30 the range would find it and the formula would start as E30*G30.
Any help would be greatly appreciated.
Private Sub calc()
Dim lastrow As Long
Dim rng As Range
lastrow = ThisWorkbook.Worksheets("Indiv").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("F26:F" & lastrow)
rng.Formula = "=Round((E26*G26),2)"
End Sub
You need to find the first free row in column F and then bulid your formula with this row:
Option Explicit
Private Sub calc()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Indiv")
Dim LastRowA As Long ' find last used row in column A
LastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim FirstFreeRowF As Long ' find first free row in column F (if first 2 rows have data)
FirstFreeRowF = ws.Cells(1, "F").End(xlDown).Row + 1
' fix issue if first or second row is empty
If FirstFreeRowF = ws.Rows.Count + 1 Then
If ws.Cells(1, "F").Value = vbNullString Then
FirstFreeRowF = 1
ElseIf ws.Cells(2, "F").Value = vbNullString Then
FirstFreeRowF = 2
End If
End If
' define range to add formula
Dim Rng As Range
Set Rng = ws.Range("F" & FirstFreeRowF, "F" & LastRowA)
' add formula
Rng.Formula = "=Round((E" & FirstFreeRowF & "*G" & FirstFreeRowF & "),2)"
End Sub
So this will consider F5 the first free row and fill in the formula in the selected range as seen below:
I think you should find the last used row in column F, so that you could know the next row is blank
lastrowF=sheets(sheetname).range("F" & rows.count).end(xlup).row
So the next row would be like
range("F" & lastrowF+1).formula="Round((E" & lastrowF+1 & "*G" & lastrowF+1 & ",2)"
This is what my end result should look like. If there is not the four digits to move over to the second column then fill with 4 zeros.
How can I split zip code in a column into 2 columns and fill empty cells in column 2 if first column has only 5 digits?
Here is what I have been working with
Dim ws As Worksheet
Dim cell As Range
Set ws = Worksheets("sheet1")
For Each cell In ws.Range("K2:K500").Cells
cell.Offset(0, 1).Value = Left(cell.Value, 5)
Next cell
Dim cel As Range, rngC As Range, rngB As Range
Dim lastRowA As Long, lastRowB As Long
With ws
lastRowK = .Cells(.Rows.Count, "K").End(xlUp).Row 'last row of column A
lastRowL = .Cells(.Rows.Count, "L").End(xlUp).Row 'last row of column B
For Each cel In .Range("K2:K" & lastRowL) 'loop through column L
'check if cell in column A exists in column B
If WorksheetFunction.CountIf(.Range("K2:K" & lastRowL), cel) = 0 Then
cel.Offset(0, 3).Value = Right(cel.Value, 4)
'.Range("M" & cel.Row) = Right(cell.Value, 4)
Else
.Range("M" & cel.Row) = "0000"
End If
Next
End With
In case you want to bypass VBA and use formulas, you can do this.
Cell B2:
=LEFT(A2,5)
Cell C2:
=IF(LEN(A2)=9,RIGHT(A2,4),"0000")
One of the simplest ways to solve this problem is to supplement the original string with a large number of zeros and take the values of the first and second five characters for two cells:
Sub setZIPandZeros()
Const TEN_ZEROS = "0000000000" ' 10 times
Dim ws As Worksheet
Dim cell As Range
Dim sLongString As String
Set ws = Worksheets("Sheet1")
For Each cell In ws.Range("K2:K" & ws.Cells(ws.Rows.Count, "K").End(xlUp).Row).Cells
sLongString = Trim(cell.Text) & TEN_ZEROS
cell.Offset(0, 1).Resize(1, 2).NumberFormat = "#"
cell.Offset(0, 1).Resize(1, 2).Value = Array(Left(sLongString, 5), _
Mid(sLongString, 6, 5))
Next cell
End Sub
Update The modified code is much faster and gives a result that more closely matches the description of the task:
Sub setZipZeros()
Dim ws As Worksheet
Dim rResult As Range
Set ws = Worksheets("Sheet1")
' Addressing R1C1 is used in the formulas - If the original range
' is shifted to another column, you will need to change the letter
' of the column "K" only in this line
Set rResult = ws.Range("K2", ws.Cells(ws.Rows.Count, "K").End(xlUp)).Offset(0, 1)
' If the columns L:M are already in text format, then instead of
' the results we will get the texts of formulas
rResult.Resize(, 2).NumberFormat = "General"
' These two lines do most of the work:
rResult.Formula2R1C1 = "=LEFT(TRIM(RC[-1])&""00000"",5)"
rResult.Offset(0, 1).Formula2R1C1 = "=MID(TRIM(RC[-2])&""000000000"",6,4)"
' We don't know if auto-recalculation mode is on now
' Application.Calculation = xlAutomatic
ActiveSheet.Calculate
Set rResult = rResult.Resize(, 2)
' Set the text format for the cells of the result
' to prevent conversions "00123" to "123"
rResult.NumberFormat = "#"
' Replace formulas with their values
rResult.Value = rResult.Value
End Sub
So data gets pasted in to column B as the code keeps running it'll do a condition check to see there's any values in column B and paste a value in to the adjacent column A. I need to make it so it does two condition checks:
If there's values in column b, but then to check if there's values in column A before pasting so it doesn't overwrite different data that's been pasted already.
For Each Cell In y.Sheets("Compiled").Range("A:B")
If Range("B:B").Value <> "" And Range("A:A").Value = "" Then
Cell.Offset(0, -1).PasteSpecial xlPasteValues
End If
Next
You were close, don't try to loop over a multiple column range:
Sub Test()
For Each Cell In y.Sheets("Compiled").Range("B:B")
If Cell.Value <> "" And Cell.Offset(0, -1).Value = "" Then
Cell.Offset(0, -1).Value = Cell.Value
End If
Next
End Sub
NOTE: You are looping through every cell in Range("B:B") which is probably unnecessary. It'd be better if you use a lastrow value, or a static range like Range("B2:B1000"). Or you could use a criteria to exit your loop like If Cell.Value = "" Then Exit For.
Here's a version of the code that implements the lastrow value that dwirony mentioned in their answer. This also throws everything in arrays, so it might go a bit faster if you have a really large dataset.
Option Explicit
Sub test()
Dim ACol As Variant
Dim BCol As Variant
Dim lastrow As Long
Dim i As Long
lastrow = Range("B:B").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
BCol = Range("B1:B" & lastrow).Value
ACol = Range("A1:A" & lastrow).Value
For i = LBound(BCol) To UBound(BCol)
If IsEmpty(ACol(i, 1)) And Not IsEmpty(BCol(i, 1)) Then
ACol(i, 1) = BCol(i, 1)
End If
Next i
Range("A1:A" & lastrow).Value = ACol
End Sub
I have an Excel file with information in column A and column B. Since these columns could vary in the number of rows I would like to use the function offset so that I could print the formula in one time as an array rather than looping over the formula per cell (the dataset contains almost 1 million datapoints).
My code is actually working the way I want it to be I only can't figure out how to print the code in Range(D1:D5). The outcome is now printed in Range(D1:H1). Anybody familiar how to use this offset within a for statement?
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(0, i + 2).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
Using the Offset(Row, Column), you want to offset with the increment of row (i -1), and 3 columns to the right (from column "A" to column "D")
Try the modified code below:
Set example = Range("A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
One way of outputting the formula in one step, without looping, to the entire range, is to use the R1C1 notation:
Edit: Code modified to properly qualify worksheet references
Option Explicit
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set example = .Range(.Cells(1, 1), .Cells(LastRow, 1))
End With
example.Offset(columnoffset:=3).FormulaR1C1 = "=sum(rc[-3],rc[-2])"
End Sub
You don't need to use VBA for this. Simply type =sum(A1:B1) in cell D1 and then fill it down.
If you're going to use VBA anyway, use this:
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
The way offset works is with row offset, column offset. You want the column to always be fixed at 3 to the right.