So i have 7 columns, column 5 (E) is date. I am searching for all rows for the date, and copying them to sheet 2 (from 1) based on my imput. Problem is i need to only copy A,B,C,D,E but leave out the last 2 columns. What is the correct syntax for this?
Atm i have:
Rows(i).Copy Destination:=Sheets(2).Rows(Lastrowa)
but this copies my entire row instead of just the first 5 cells of the row. Full code below
Sub Check_Dtaes()
'And Format
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim ans As Date
Dim anss As Date
Dim Lastrow As Long
Dim Lastrowa As Long
ans = InputBox("Start Date Is")
anss = InputBox("End Date Is")
Lastrow = Sheets(1).Cells(Rows.Count, "E").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "E").End(xlUp).Row + 1
For i = 1 To Lastrow
If Cells(i, "E").Value >= ans And Cells(i, "E").Value <= anss Then
Rows(i).Copy Destination:=Sheets(2).Rows(Lastrowa)
Lastrowa = Lastrowa + 1
End If
Next
Sheets(2).Range("E1:E" & Lastrowa).NumberFormat = "dd/mm/yyyy"
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You entered a inproper date"
Application.ScreenUpdating = True
End Sub
Thanks in advance
Range("A" & i & ":E" & i) // Credit to BigBen, thanks
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 am trying to match a value from a cell (grid_2.range "A1") and grid_2.range("B1") with a column P on a sheet named grid_2 ("Grid2") to copy all the row where there value is located. Therefore, I will need to check on my data and copy/paste the entire row to another sheet maned grid. But for some reason my code loops but only find the match and copy and paste once.
Sub new_copyPaste()
Dim targetSh As Worksheet
Dim i As Variant
Dim lastRow As Long
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("A1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("B1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
Maybe do you know what I am doing wrong?
I thought about using VLookup, but after researching, it seems that function match would be more appropriate.
I am open for suggestions :)
Match only returns the first match and is not needed here:
Sub new_copyPaste()
Dim lastRow As Long
Dim i As Long
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
I have excel with 5 different sheets.
sheet3 and sheet4 i want delete rows based on the single column cell value.
in sheet 3 i want to delete rows based on H column cell values if H2="#N/A" and H503="#N/A" then delete entire rows.
in sheet 4 i want to delete rows based on b column cell values if B2="320857876",B3="32085678",B4="12133435" the delete the entire rows where B column cell values starts with 302.
and i want to delete all Data from 'C' column
My excel sheet is like this
Using excel file
Sub Create()
Dim LastRow As Long
Dim i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i) = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
You've got a few requirements there and your code is fairly light but regarding the #N/A part of it, you can't just test for that text using the value approach, which is the default property returned for a range object.
Sub Create()
Dim LastRow As Long, i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i).Text = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
... you need to use .Text to get that to work, or, If IsError(Range("B" & i)) Then is another approach.
The rest of your requirements is just logic. The rest of your code is relatively sound so you just need to work through it.
I hope that helps.
Sub delete_rows()
Dim sheet As Worksheet, cell As Range
Count = 1
For Each sheet In ThisWorkbook.Worksheets
If Count = 3 Then
lastrow = sheet.Cells(sheet.Rows.Count, "H").End(xlUp).Row
Set Rng = sheet.Range("H1:H" & lastrow)
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.IsNA(Rng(i).Value) Then
Rng(i).EntireRow.Delete
ElseIf Rng(i).Value = "#NA" Then
Rng(i).EntireRow.Delete
End If
Next
ElseIf Count = 4 Then
lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Set Rng = sheet.Range("B1:B" & lastrow)
Debug.Print (Rng(4).Text)
If Rng(2).Value = "320857876" And Rng(3).Value = "32085678" And Rng(4).Value = "12133435" Then
For i = Rng.Cells.Count To 1 Step -1
If Left(Rng(i).Value, 3) = "302" Then
Rng(i).EntireRow.Delete
End If
Next
End If
lastrow = sheet.Cells(sheet.Rows.Count, "C").End(xlUp).Row
Set Rng = sheet.Range("C1:C" & lastrow)
For Each cell In Rng
cell.Value = ""
Next cell
End If
Count = Count + 1
Next
End Sub
Hello Stack overflow community and thanks in advance for all the help you could give me.
I am currently trying to create a loop to go through a column and create a sum of the data that is below that till the next blank line and in the next blank line create a new sum again doing the same process till that we get to two blanks following each other.
The below code does something similar but in the sum is upward and not downward.
Would anybody have a solution? Thanks a million for your help.
Dim cell As Range
Dim offset_rows As Long
Set cell = Range("O2")
Do While Not IsEmpty(cell.Offset(1, 0))
offset_rows = Range(cell, cell.End(xlDown)).Rows.Count - 1
Set cell = cell.End(xlDown).Offset(1, 0)
'cell.FormulaR1C1 = "=SUM(R[-" & offset_rows & "]C:R[-1]C)"
cell.FormulaR1C1 = "=SUM(R[" & offset_rows & "]C:R[1]C)"
Loop
I slightly tweaked the macro and it does now the sum downward.
Thanks again so much for your help, really appreciate it!
Sub SumRowsAbove()
Dim StartRow As Long
Dim SumRow As Long
Dim lRow As Long
Dim LastRow As Long
Dim BlankRowsCtr As Integer
Dim FormulaRow As Integer
' modify to your sheet name
With Sheets("Macroprep")
' find last row with data in column "O"
LastRow = .Cells(.Rows.Count, "O").End(xlUp).Row
StartRow = 3
BlankRowsCtr = 0
For lRow = 2 To LastRow + 1
If Not IsEmpty(.Cells(lRow, "O")) Then
SumRow = lRow
BlankRowsCtr = 0
Else
BlankRowsCtr = BlankRowsCtr + 1
' if 2 or more rows are empty >> exit sub
If BlankRowsCtr >= 2 Then Exit Sub
FormulaRow = StartRow - 1
.Cells(FormulaRow, "O").Formula = "=SUM(O" & StartRow & ":O" & SumRow & ")"
StartRow = lRow + 1
End If
Next lRow
End With
End Sub
Hi guys I am running a macro in Excel 2003 to match property addresses to their owners addresses so I end up with a report of absentee owners.
So in:
column A column C
10 Smith DR Smithville 10 Smith DVE, Smithfield, 49089 Antartica
This is how some of the raw data has been input but I need for this record and all the other slightly different records to be a match and therefore not selected by the macro
as it searches for absentee owners addresses then populates the selected records to sheet2.
In laymans terms if I could compare say only the first 6 characters in column A to the first 6 characters in column C then I think it would work the way I need it to.
Does anyone know how I can achieve this within my macro shown below
Sub test()
Dim i As Long, lr As Long, r As Long, ws As Worksheet, value As Variant,
val As Variant
Dim sval As Integer, lr2 As Long
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
value = Split(Cells(i, 1).value, ", ")
For val = LBound(value) To UBound(value)
sval = InStr(1, Cells(i, 3).value, value(val), 1)
If sval = 0 Then Range("A" & i & ":" & "C" & i).Interior.Color = 65535
Next
Next
For r = 2 To lr
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & r).Interior.Color = 65535 Then
Rows(r).Copy Destination:=Sheets("Sheet2").Rows(lr2 + 1)
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
Sheets("Sheet2").Cells.Interior.ColorIndex = 0
Application.ScreenUpdating = True
MsgBox "Done Macro"
End Sub
Hopefully I have pasted the code in the correct format required here.
So any help and guidance would be much appreciated.
You can use the formula LEFT(). This will check the first 6 characters from the cell in column A to the first 6 characters in column C. If there's a match, it will add the value from column A to the next free cell in column A, Sheet2.
Sub First6Characters()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRowSheet2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Left(Range("A" & i), 6) = Left(Range("C" & i), 6) Then
Sheets("Sheet2").Range("A" & LastRowSheet2).Value = Range("A" & i).Value
LastRowSheet2 = LastRowSheet2 + 1
End If
Next i
End Sub
Source: http://www.techonthenet.com/excel/formulas/left.php