I am trying to write some VBA code that will search a worksheet called "01 Feb 19", column (T) and look for the word "Deployed", if it finds that word will then copy the entire row into a new worksheet called "deployed". I've added a For loop and I know I need to add a Next but I can't figure it out.
Here's my code so far.
Sub CopyRows()
Dim cell As Range
Dim lastRow As Long
Dim i As Long
Dim wksh1 As Worksheet
Set wksh1 = Worksheets("01 Feb 19")
Dim wksh2 As Worksheet
Set wksh2 = Worksheets("Deployed")
lastRow = Range("A" & Rows.Count).End(xlUp).Row 'finds the last row
i = 1
For Each cell In wksh1.Range("T1:T" & lastRow) 'looks in T column until the last row
If cell.Value = "Deployed" Then 'searches for word deployed
cell.EntireRow.Copy wksh2.Cells(i, 1) 'copies entire row into Deployed work sheet
End If
End Sub
You're missing Next cell at the end of your For loop
Sub CopyRows()
Dim cell As Range
Dim lastRow As Long
Dim i As Long
Dim wksh1 As Worksheet
Set wksh1 = Worksheets("01 Feb 19")
Dim wksh2 As Worksheet
Set wksh2 = Worksheets("Deployed")
lastRow = Range("A" & Rows.Count).End(xlUp).Row 'finds the last row
i = 1
For Each cell In wksh1.Range("T1:T" & lastRow) 'looks in T column until the last row
If cell.Value = "Deployed" Then 'searches for word deployed
cell.EntireRow.Copy wksh2.Cells(i, 1) 'copies entire row into Deployed work sheet
i = i + 1 ' <-- Added so that rows don't overwrite each other. Remove if it is intended to overwrite each row
End If
Next cell ' <-- Added
End Sub
Related
Please i have this issue and i am trying to achieve a solution using vba.
So cell
A1 has value John
A2-A3 blank
A4 has value Mary
A5-A9 blank
A10 has value Mike
A11-A14 blank
And A15 has value David
I wanna autofill only the blank spaces in the column A, like so:
A2-A3 the blanks will be filled with John
A5-A9 will be filled with Mary
A11-A14 with Mike.
So technically, I am auto filling the blank cells with the value from above
One version to do this is:
Sub Autofill1()
Dim ws As Worksheet
Dim lrow As Long
Dim i As Long
Set ws = Worksheets("Sheet1") 'Set your worksheet name
lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row
For i = 1 To lrow 'Loop from 1st row to last row
If ws.Cells(i, "A").Value = "" Then 'If the cell value is blank then...
ws.Cells(i, "A").Value = ws.Cells(i - 1, "A").Value '.. copy the value from previous cell above
End If
Next i
End Sub
Another version is:
Sub Autofill2()
Dim ws As Worksheet
Dim FillRange As Range
Set ws = Worksheets("Sheet1") 'Set your worksheet name
On Error GoTo Errhand 'If range already is filled then go to error handler
For Each FillRange In Columns("A:A").SpecialCells(xlCellTypeBlanks) 'Define range in column A
If FillRange.Cells.Row <= ActiveSheet.UsedRange.Rows.Count Then 'Check if current row is smaller than last row
FillRange.Cells = ws.Range(FillRange.Address).Offset(-1, 0).Value 'Fill the empty cells with the non empty values
End If
Next FillRange
Errhand:
If Err.Number = 1004 Then MsgBox ("Column is already filled")
End Sub
It has been a long time, but if I'm not mistaken, the following should work:
Dim i As Integer, firstcell As Integer, lastcell As Integer
Dim currentValue As String
firstcell = 1
lastcell = 15
currentValue = ""
For i = firstcell To lastcell
If Cell(i,1).Value = "" Then
Cell(i,1).Value = currentValue
Else
currentValue = Cell(i,1).Value
End If
Next i
You loop through the cells and if there is nothing in them you write the last value in them. If they contain data, you update the currentValue
This solution using for each for more efficient looping.
Sub AutoFillIt()
Dim lLastRow As Long 'Last row of the target range
lLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Get number of rows
Dim rngCurrentCell As Range
Set rngCurrentCell = Range("A1") 'It will used for looping through the range
Dim rngTarget As Range
Set rngTarget = rngCurrentCell.Resize(lLastRow) 'Set the range working in
Dim vLastValue As Variant ' To store the value of the last not emplty cell
Dim v As Variant
For Each v In rngTarget 'looping through the target range
If v = "" Then 'if the cell is empty, write the last value in
rngCurrentCell.Value = vLastValue
Else 'if not empty, store the content as last value
vLastValue = v
End If
Set rngCurrentCell = rngCurrentCell.Offset(1) 'move to the next cell
Next v
End Sub
I know the "Last Row" question has already come up several times but even when looking at existing threads I cannot find what is happening. It is the first time I write a Macro so I have only been able to get to a certain point I paste the code and ask the questions later:
Option Explicit
Sub Practice()
'Last Row Searcher
Dim Sht As Worksheet
Set Sht = ActiveSheet
Dim Last_Row As Long
With Sht
Last_Row = .Range("A9999").End(xlUp).Row
End With
'Column A to D
Sheet9.Select
Range("A2:A" & Last_Row).Copy
Sheet11.Select
Range("D" & Last_Row).Select
ActiveSheet.Paste
'Column C to F
Sheet9.Select
Range("C2:C" & Last_Row).Copy
Sheet11.Select
Range("F" & Last_Row + 1).Select
ActiveSheet.Paste
'Column E to G
Sheet9.Select
Range("E2:E" & Last_Row).Copy
Sheet11.Select
Range("G" & Last_Row + 1).Select
ActiveSheet.Paste
'Column I to L
Sheet9.Select
Range("I2:I" & Last_Row).Copy
Sheet11.Select
Range("L" & Last_Row + 1).Select
ActiveSheet.Paste
End Sub
Question 1:
When I paste what I have copied to the other worksheet it directly pastes things in the "Last_Row" from the previous worksheet instead of looking for the new "Last_Row" of the Active Sheet. Is there a way around this?
Question 2
I repeat the same code several times but with different columns, because they are not together I copy column A to D, then C to F, etc.
It is working for me, but out of curiosity, is there a way to do it all at once?
(First Empty Row After) Last Non-Empty Row
Option Explicit
Sub Practice()
'Last Row Searcher
Const frSrc As Long = 2 ' Source First Row
Const strSrc As String = "A,C, E, I" ' Source Column Letters
Const strTgt As String = "D, F,G, L" ' Target Column Letters
Dim wsSrc As Worksheet ' Source Worksheet
Dim wsTgt As Worksheet ' Target Worksheet
Dim rngSrc As Range ' Source Column Range
Dim rngTgt As Range ' Target Column Range
Dim vntS As Variant ' Source Column Array
Dim vntT As Variant ' Target Column Array
Dim lrSrc As Long ' Source Last Non-Empty Row
Dim frTgt As Long ' Target First Row After Last Non-Empty Row
Dim i As Long ' Source and Target Array Elements Counter
Dim colSrc As String ' Source Column Letter
Dim colTgt As String ' Target Column Letter
' Beware, you are using CodeNames, which are not the names on the TAB.
Set wsSrc = Sheet9
Set wsTgt = Sheet11
' Populate Column Arrays (vntS, vntT).
vntS = Split(strSrc, ","): vntT = Split(strTgt, ",")
' Loop through elements of Source (or Target) Column Array.
For i = 0 To UBound(vntS)
' Calculate Column Letter (colSrc, colTgt)
colSrc = Trim(vntS(i)): colTgt = Trim(vntT(i))
' Calculate Source Last Non-Empty Row.
lrSrc = wsSrc.Range(colSrc & wsSrc.Rows.Count).End(xlUp).Row
' Calculate Target First Row After Last Non-Empty Row.
frTgt = wsTgt.Range(colTgt & wsTgt.Rows.Count).End(xlUp).Row + 1
' Calculate Source Column Range.
Set rngSrc = wsSrc.Range(colSrc & frSrc & ":" & colSrc & lrSrc)
' Calculate Target Column Range.
Set rngTgt = wsTgt.Range(colTgt & frTgt).Resize(rngSrc.Rows.Count)
' Write values of Source Column Range to Target Column Range.
rngTgt.Value = rngSrc.Value
Next
End Sub
EDIT:
Sub Practice2()
'Last Row Searcher
Const frSrc As Long = 2 ' Source First Row
Const strSrc As String = "A,C, E, I" ' Source Column Letters
Const strTgT As String = "D, F,G, L" ' Target Column Letters
Dim wsSrc As Worksheet ' Source Worksheet
Dim wsTgt As Worksheet ' Target Worksheet
Dim rngSrc As Range ' Source Column Range
Dim rngTgt As Range ' Target Column Range
Dim vntS As Variant ' Source Column Array
Dim vntT As Variant ' Target Column Array
Dim lrSrc As Long ' Source Last Non-Empty Row
Dim frTgt As Long ' Target First Row After Last Non-Empty Row
Dim i As Long ' Source and Target Array Elements Counter
Dim colSrc As String ' Source Column Letter
Dim colTgt As String ' Target Column Letter
' Beware, you are using CodeNames, which are not the names on the TAB.
Set wsSrc = Sheet9
Set wsTgt = Sheet11
' Populate Column Arrays (vntS, vntT).
vntS = Split(strSrc, ",")
vntT = Split(strTgT, ",")
' Calculate Target First Row After Last Non-Empty Row.
frTgt = wsTgt.Range(Trim(vntT(0)) & wsTgt.Rows.Count).End(xlUp).Row + 1
' Loop through elements of Source (or Target) Column Array.
For i = 0 To UBound(vntS)
' Calculate Column Letter (colSrc, colTgt)
colSrc = Trim(vntS(i)): colTgt = Trim(vntT(i))
' Calculate Source Last Non-Empty Row.
lrSrc = wsSrc.Range(colSrc & wsSrc.Rows.Count).End(xlUp).Row
' Calculate Source Column Range.
Set rngSrc = wsSrc.Range(colSrc & frSrc & ":" & colSrc & lrSrc)
' Calculate Target Column Range.
Set rngTgt = wsTgt.Range(colTgt & frTgt).Resize(rngSrc.Rows.Count)
' Write values of Source Column Range to Target Column Range.
rngTgt.Value = rngSrc.Value
Next
End Sub
You need to set define the "last row" more clearly. In your case, I believe what you want is to find the last row of the source data AND then paste it after the last row of your destination sheet. So try something like this:
Dim srcWS As Worksheet
Set srcWS = Sheet9
Dim dstWS As Worksheet
Set dstWS = Sheet11
Dim srcLastRow As Long
With srcWS
srcLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim dstLastRow As Long
With dstWS
dstLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With
srcWS.Range("A2:A" & srcLastRow).Copy
dstWS.Range("D" & dstLastRow).Paste
No Select or ActiveSheet is necessary (which you should avoid whenever you can).
Adding another answer here because my previous answer was incomplete (and it's been bothering me since yesterday!). Since this is a repetitive bit of code, I would separate the column-copy into it's own sub. Your logic becomes very simple in your main routine.
Option Explicit
Sub test()
CopyMyColumn Sheet1.Range("A1").EntireColumn, Sheet1.Range("D1").EntireColumn
CopyMyColumn Sheet1.Range("C1").EntireColumn, Sheet1.Range("F1").EntireColumn
CopyMyColumn Sheet1.Range("E1").EntireColumn, Sheet1.Range("G1").EntireColumn
CopyMyColumn Sheet1.Range("I1").EntireColumn, Sheet1.Range("L1").EntireColumn
End Sub
Private Sub CopyMyColumn(ByRef srcColumn As Range, ByRef dstColumn As Range)
'--- copies the source column from row 2 to the end of the data, to
' the destination column, appending to the end of the existing data
Dim srcLastRow As Long
With srcColumn
srcLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Dim dstLastRow As Long
With dstColumn
dstLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Dim src As Range
Dim dst As Range
Set src = srcColumn.Cells(2, 1).Resize(srcLastRow, 1)
Set dst = dstColumn.Cells(1, 1).Offset(dstLastRow, 0).Resize(srcLastRow, 1)
dst.Value = src.Value
End Sub
I am trying to add a button, that adds a new column after the last column with values. This works.
Now I want to copy values to the new column. Values shall be copied from the last column from row 32 to the last one with a value in column A.
Right now Ihave a code for copying the whole column. How do I concentrate on the specific range?
Sub AddMeeting()
Dim ws As Worksheet
Dim lastcol As Long
Set ws = ActiveSheet
lastcol = ws.Cells(32, ws.Columns.Count).End(xlToLeft).Column
Columns(lastcol).Copy Destination:=Columns(lastcol + 1)
Range ((Cells.Columns.Count.End(xlLeft)) & Range(32)), (lastcol + 1) & Cells.Rows.Count.End(xlUp)
Application.CutCopyMode = False
End Sub
Values shall be copied from the last column from row 32 to the last one with a value in column A
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim LastColumn As String
Dim rngToCopy As Range
'~~> Set this to the relevant worksheet
Set ws = Sheet1
With ws
'~~> Find last row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Find last column in row 32
lCol = .Cells(32, .Columns.Count).End(xlToLeft).Column
'~~> Get Column Name from column number
' https://stackoverflow.com/questions/10106465/excel-column-number-from-column-name
LastColumn = Split(Cells(, lCol).Address, "$")(1)
Set rngToCopy = .Range("A32:" & LastColumn & lRow)
Debug.Print rngToCopy.Address
With rngToCopy
'
' Do what you want here
'
End With
End With
End Sub
I have a range of cells (dynamic number of rows) that I want to copy over starting with A1 cell. The below code isn't working for me as it is not moving the entire range of cell values from current location to A1. Please advise.
Range("E:E").Cut Range("A1")
Example,
If range in E is 50 rows, the cut and move should start at A1 and end at A50.
If range in E is 999 rows, the cut and move should start at A1 and end at A999.
As per your comment above, see below code:
Sub CutPaste()
Dim i As Long
Dim sRow As Long, eRow As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'set the last row of data
eRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
'find the start row of data
For i = 1 To eRow
If ws.Range("E" & i).Value <> "" Then
sRow = i
Exit For
End If
Next i
'now cut and paste
ws.Range("E" & sRow, "E" & eRow).Cut ws.Range("A1").Paste
'clear clipboard and object
Application.CutCopyMode = False
Set ws = Nothing
End Sub
This should work for you:
Sub Kopy()
Dim N As Long
N = Cells(Rows.Count, "E").End(xlUp).Row
Range("E1:E" & N).Cut Range("A1")
End Sub
NOTE:
You do not need to specify the same dimensions for the destination. A single cell will do.
Before:
and after:
I have a script that is used to find the last entry in a particular table column across different sheets and paste them into a master sheet list. It's operating as "find last used row in column B" but evidently table rows, even if they're blank, count as used rows and so most of my returns are blank because the actual value I'm looking for was entered at the top of the table instead of in the last row. It's also important to note that there are multiple stacked tables on these sheets, but each table only ever has ONE value in the B column, and I'm only ever looking for the most recent one.
Is there a way to tell excel not to count blank table rows as used rows? I'm only interested in returning the last value in column B, even if it may not be the last table row.
Dim rng As Range
Dim cell As Range
Dim result As String
Dim result_sheet As Long
Dim LastRow As Long
Set rng = Range("A2:A200")
For Each cell In rng
result = cell.Value
LastRow = Worksheets(result).Cells(Worksheets(result).Rows.Count, "B").End(xlUp).row
cell.Offset(0, 1).Value = Worksheets(result).Range("B" & LastRow).Value
Next cell
Here is one way
Sub Sample()
Dim ws As Worksheet
Dim tmplRow As Long, lRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
tmplRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = tmplRow To 1 Step -1
If Len(Trim(.Range("B" & i).Value)) <> 0 Then
lRow = i
Exit For
End If
Next i
If lRow = 0 Then lRow = 1
MsgBox "The last row is " & lRow
End With
End Sub
Screenshot
And another way
Sub Sample()
Dim ws As Worksheet
Dim tbl As ListObject
Dim lRow As Long, endRow As Long, startRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Change this to the relevant table number
Set tbl = .ListObjects(1)
endRow = tbl.Range.Rows.Count
startRow = tbl.Range.Row
For i = endRow To startRow Step -1
If Len(Trim(.Range("B" & i).Value)) <> 0 Then
lRow = i
Exit For
End If
Next i
MsgBox lRow
End With
End Sub