I was trying to figure out how to have excel look at a cell in my workbook, if the cell has a value greater than 0 then copy that row into sheet2. It then looks at the next cell in the column.
Does anyone know??
I need it looking at cell I10 to start off and if I10>0 copy data from A10:K10 to sheet2 else look at I11 and repeat, then I12... until all 750+ rows are either copied or not.
Thanks so much for all the help!!!
Option Explicit
Sub Macro1()
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("I" & Rows.Count).End(xlUp).Row
i = 10 ' change this to the wanted starting row in sheet2
For Each cell In Sheets(1).Range("I10:I" & lastRow)
If cell.Value > 0 Then
cell.EntireRow.Copy Sheets(2).Cells(i, 1)
i = i + 1
End If
Next
End Sub
you can use AutoFilter() method of Range object and avoid looping through cells:
Sub Main()
With Worksheets("OriginWs") '<--| change "OriginWs" to your actual data worksheet name
With .Range("I9", .Cells(.Rows.Count, "I").End(xlUp))
If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1) = "dummyheader"
.AutoFilter Field:=1, Criteria1:=">0"
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Offset(1, -8).Resize(.Rows.Count - 1, 11).SpecialCells(xlCellTypeVisible).Copy Worksheets("TargetWs").Cells(1, 1) '<--| change "TargetWs" to your actual destination worksheet name
If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents
End With
.AutoFilterMode = False
End With
End Sub
BTW, the statements:
If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1) = "dummyheader"
and
If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents
can be avoided if your cell I9 has some text for sure
Related
It's been a decade since I've written VBA and trying to reach out to see what I broke. I wrote a macro which copies data from one sheet to another, 1 column at a time for 4 different columns, and pastes it in the next free cell. This formula worked but I would like to adjust it to only copy certain data. Below is an example, I am trying to only copy A if the date value in E is equal to the input date value you enter when the macro starts. I am having most trouble balancing the If/Then with the For/Next. Every time I place an End If or Next, I receive errors.
Dim DateValue As Variant
DateValue = InputBox("Enter the date to copy")
'copy and paste column A to column A if E = input date
For Each Cell In Worksheets("Enrichment Report").Range("E:E")
If Cell.Value = DateValue Then
Sheets("Enrichment Report").Select
iMaxRow = 100
For iCol = 1 To 1
For iRow = 2 To iMaxRow
With Worksheets ("Enrichment Report").Cells(iRow, iCol)
If .Value = "" Then
'empty row, do nothing
Else
.Copy
Sheets("Intake Form").Select
Range (A" & Rows.Count).End(xlUp).Offset(1).Select
Activesheet.Paste
End If
End With
Next
End If
Next iRow
Next iCol
I think the following code will be much easier for you to follow
Also, it will be much faster looping through occupied cells with data in Column E, and not the entire column.
Code
Option Explicit
Sub Test()
Dim LastRow As Long, iMaxRow As Long, iCol As Long, iRow As Long
Dim DateValue As Variant
Dim Cell As Range
DateValue = InputBox("Enter the date to copy")
With Worksheets("Enrichment Report")
' get last row with data in column E
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
'copy and paste column A to column A if E = input date
For Each Cell In .Range("E1:E" & LastRow)
If Cell.Value = DateValue Then
iMaxRow = 100
For iCol = 1 To 1
For iRow = 2 To iMaxRow
If .Cells(iRow, iCol).Value = "" Then
'empty row, do nothing
Else
.Cells(iRow, iCol).Copy
Sheets("Intake Form").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
End If
Next iRow
Next iCol
End If
Next Cell
End With
End Sub
you could use AutoFilter() and avoid looping
also, use Application.InputBox() method instead of VBA InputBox() function to exploit its Type parameter and force a numeric input
Sub mmw()
Dim targetSht As Worksheet
Set targetSht = Sheets("Intake Form")
Dim DateValue As Variant
DateValue = Application.InputBox("Enter the date to copy", , , , , , , 2)
With Worksheets("Enrichment Report") ' reference your "source" sheet
With .Range("A1", .Cells(.Rows.Count, "E").End(xlUp)) ' reference its columns A:E cells from row 1 down to column E last not empty cell
.AutoFilter Field:=1, Criteria1:="<>" 'filter on referenced range 1st column with not empty cells
.AutoFilter Field:=5, Criteria1:=CStr(CDate(DateValue))
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then _
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Intake Form").Cells(Sheets("Intake Form").Rows.Count, "A").End(xlUp).Offset(1) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
End With
.AutoFilterMode = False
End With
End Sub
Obviously, with the proper indentation done by CallumDA, it should be written as below. Also there is a typo in the Range (A", it should be Range ("A":
For Each Cell In Worksheets("Enrichment Report").Range("E:E")
If Cell.Value = DateValue Then
Sheets("Enrichment Report").Select
iMaxRow = 100
For iCol = 1 To 1
For iRow = 2 To iMaxRow
With Worksheets ("Enrichment Report").Cells(iRow, iCol)
If .Value = "" Then
'empty row, do nothing
Else
.Copy
Sheets("Intake Form").Select
Range ("A" & Rows.Count).End(xlUp).Offset(1).Select
Activesheet.Paste
End If
End With
Next iRow
Next iCol
End If
Next
I have a sheet called Backlog containing rows and columns of data. I need code that will search row by row in the 2nd to last column looking for #N/A. When it finds #N/A it needs to check the last column if it contains a C or not. If it contains a C then the whole row should be appended to a sheet called Logoff. If the last column does not contain a C then the whole row should be appended to a sheet called Denied. The row should be deleted from the original Backlog sheet once moved to either Logoff or Denied. The code I have below is not working. After the first For Statement it goes to End Sub, but there is not any compiling errors.
Private Sub CommandButton2_Click()
Dim IMBacklogSh As Worksheet
Set IMBacklogSh = ThisWorkbook.Worksheets("Backlog")
Dim logoffSh As Worksheet
Set logoffSh = ThisWorkbook.Worksheets("Claims Logged off")
Dim deniedsh As Worksheet
Set deniedsh = ThisWorkbook.Worksheets("Claims Denied")
IMBacklogSh.Select
Dim i As Long
For i = 3 To Cells(Rows.Count, 13).End(xlUp).Row
If Cells(i, 13).Value = "#N/A" Then
If Cells(i, 14).Value = "C" Then
IMBacklogSh.Rows(i).EntireRow.Copy Destination:=logoffSh.Range("A" & logoffsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
Else
IMBacklogSh.Rows(i).EntireRow.Copy Destination:=deniedsh.Range("A" & deniedsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
End If
Next i
End Sub
Try it as If Cells(i, 13).Text = "#N/A" Then . #N/A is an error code, not a value; however, the Range.Text property can be examined or the IsError function could be used to examine the cell's contents for any error.
If Cells(i, 13).Text = "#N/A" Then
'Alternate with IsError
'If IsError(Cells(i, 13)) Then
If Cells(i, 14).Value = "C" Then
IMBacklogSh.Rows(i).EntireRow.Copy _
Destination:=logoffSh.Range("A" & logoffsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
Else
IMBacklogSh.Rows(i).EntireRow.Copy _
Destination:=deniedsh.Range("A" & deniedsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
End If
However, individual cell examination is not necessary and time consuming. The AutoFilter method can be used to isolate #N/A with C and #N/A with <>C.
Private Sub CommandButton2_Click()
Dim IMBacklogSh As Worksheet, logoffSh As Worksheet, deniedsh As Worksheet
Set IMBacklogSh = ThisWorkbook.Worksheets("Backlog")
Set logoffSh = ThisWorkbook.Worksheets("Claims Logged off")
Set deniedsh = ThisWorkbook.Worksheets("Claims Denied")
With IMBacklogSh
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
.AutoFilter field:=13, Criteria1:="#N/A"
.AutoFilter field:=14, Criteria1:="C"
With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.Copy Destination:= _
logoffSh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'optionally delete the originals
.EntireRow.Delete
End If
End With
.AutoFilter field:=14, Criteria1:="<>C"
With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.Copy Destination:= _
deniedsh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'optionally delete the originals
.EntireRow.Delete
End If
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
Hi I am new to VBA and have hit a wall. Tried piecing together snippets of code with the little I understand but think I am over my head. I would greatly appreciate any help constructing a block of code to achieve the following goal:
In the following worksheet
I am trying to loop through column A and identify any blank cells.
If the cells are blank I would like to copy the values in the range of 4 cells adjacent to the right of the blank cell in column A. For example: if loop identified A2 as blank cell then the loop would copy the values in range("B2:E2")
From here I would like to paste the values below the copied range to only the rows that are not blank in column A. For example: The loop would identify not blank rows in column A as ("A3:A9") and paste data below the copied range to range ("B3:E9")
The loop would stop at the next blank row in column and restart the process
Here is a screen shot of the data:
Here is what I have so far, sorry its not much Thanks in advance!
Sub select_blank()
For Each Cell In Range(ActiveCell, ActiveCell.End(xlDown))
If IsEmpty(ActiveCell.Value) = True Then
ActiveCell.Offset(, 1).Resize(, 5).copy
End If
Next
End Sub
Your code only needs a few tweaks (plus the PasteSpecial!) to get it to work:
Sub select_blank()
Dim cel As Range
With ActiveSheet
'specify that the range to be processed is from row 2 to the
'last used cell in column A
For Each cel In .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
If IsEmpty(cel.Value) Then
'If the cell is empty, copy columns B:F
cel.Offset(, 1).Resize(, 5).Copy
Else
'If the cell is not empty, paste the values previously copied
'NOTE: This relies on cell A2 being empty!!
cel.Offset(, 1).PasteSpecial
End If
Next
End With
Application.CutCopyMode = False
End Sub
I cannot make much sense of what you want, it seems to contradict itself. But, since I highly doubt anyone else is going to help you with this (per the rules), I'll give you a much better start.
Sub Test()
Dim nRow As Integer
nRow = 1
Do Until Range("A" & nRow) = "" And Range("A" & nRow + 1) = ""
If Range("A" & nRow) = "" Then
' do stuff here in the loop
End If
nRow = nRow + 1
Loop
End Sub
Sub copyRange()
Dim rngDB As Range, vDB, rng As Range
Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp))
For Each rng In rngDB
If rng = "" Then
vDB = rng.Offset(, 1).Resize(1, 4)
Else
rng.Offset(, 1).Resize(1, 4) = vDB
End If
Next rng
End Sub
I'm using this code to take a username an search for all of their associate info from multiple transactions. It should then paste them into the current worksheet. It seems to run, in that it doesn't throw up any errors and it executes the final "Select" command, but it doesn't return any pasted data.
Option Explicit
Sub InvestorReport()
Dim investorname As String
Dim finalrow As Integer
Dim i As Integer 'row counter
Sheets("Sheet1").Range("D6:K50").ClearContents
investorname = Sheets("Sheet1").Range("B3").Value
finalrow = Sheets("Investments").Range("I1000").End(xlUp).Row
For i = 2 To finalrow
If Sheets("Investments").Cells(i, 1) = investorname Then
MsgBox ("Works")
Range(Cells(i, 2), Cells(i, 12)).Copy
Sheets("Sheet1").Range("D100").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next i
Range("B3").Select
End Sub
this is the code to properly reference sheets:
Option Explicit
Sub InvestorReport()
Dim investorname As String
Dim finalrow As Long
Dim i As Long 'row counter
With Sheets("Sheet001") '<--| refer to "Sheet1" sheet
.Range("D6:K50").ClearContents '<--| with every initial "dot" you keep referencing the object after the "With" keyword ("Sheet1" sheet, in this case)
investorname = .Range("B3").value
End With
With Sheets("Investments") '<--| refer to "Investments" sheet
finalrow = .Cells(.Rows.Count, "I").End(xlUp).row '<--| .Cells and .Rows refer to "Investments" sheet
For i = 2 To finalrow
If .Cells(i, 1) = investorname Then
.Range(.Cells(i, 2), .Cells(i, 12)).Copy '<--| .Range and .Cells refer to "Investments" sheet
Sheets("Sheet001").Range("D100").End(xlUp).Offset(1, 0).PasteSpecial '<--| here all references are explicitly made to "Sheet1" sheet
End If
Next i
End With
Sheets("Sheet001").Range("B3").Select
End Sub
and here follows the code to avoid loops and exploiting Autofilter:
Sub InvestorReport2()
Dim investorname As String
Dim finalrow As Long
Dim i As Long 'row counter
With Sheets("Sheet001") '<--| refer to "Sheet1" sheet
.Range("D6:K50").ClearContents '<--| with every initial "dot" you keep referencing the object after the "With" keyword ("Sheet1" sheet, in this case)
investorname = .Range("B3").value
End With
With Sheets("Investments") '<--| refer to "Investments" sheet
With .Range("A1", .Cells(.Rows.Count, "L").End(xlUp)) '<--| refer to "Investments" sheet columns A to I fom row 1 (header) down to last non empty one in column I
.AutoFilter field:=1, Criteria1:=investorname '<--| filter data on first column values matching "investorname"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell has been filtered...
.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).SpecialCells(xlCellTypeVisible).Copy '<--| ... copy filtered cells skipping headers and first column...
Sheets("Sheet001").Range("D100").End(xlUp).Offset(1, 0).PasteSpecial '<--| ...and paste them
End If
End With
.AutoFilterMode = False '<--| .. show all rows back...
End With
Sheets("Sheet001").Range("B3").Select
End Sub
I am a VBA newbie...
I am looking for value "A" in column A. I would then like to use the row number which value "A" is located at, and copy the existing function in Column F into Column E.
This is what I tried and which clearly does not work...
Dim A_Row As Long
A_Row = Application.WorksheetFunction.Match("A", Range("A:A"), 0)
Range("E" & A_Row).Select
ActiveCell.Select
ActiveCell.Offset(0, 5).Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
Thank you in advance for your help!
In my opinion, if you are going to use vba then avoid using worksheet functions unless totally necessary.
Sub caroll()
Dim ws As Worksheet
Dim A_row As Long
Dim rng As Range
Set ws = ActiveSheet
'Loop through column A
For Each rng In ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))
'Test whether cell = "A","B", or "Z"
If VarType(rng) <> vbError Then
If rng.Value = "A" Or rng.Value = "B" Or rng.Value = "Z" Then
'If true copy column F of that row into Column E
rng.Offset(, 5).Copy rng.Offset(, 4)
End If
End If
'loop
Next rng
End Sub