I have a macro to copy data from ws1 (worksheet1) to ws2 (worksheet2).
I want to select cell G2 in ws2.
If I use .Range("G2").Select do not work.
If I use ws2.Range("G2").Select result is debug error (Run-time error '1004': Select method of Range class failed). I was trying few places and combinations. No idea how to select G2 and come back ws1 at the end of macro...
Macro:
Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")
With ws1
'assumung that data stored in column C:E, Sheet1
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
'can not make range from row 3 ???
Set rng = .Range("C1:F" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter with criteria in column 3 of range C:E
'can not make filter in row 2 ???
.AutoFilter Field:=3, Criteria1:=">0"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Range("A:D").Copy
'paste from row 3
ws2.Range("A3").PasteSpecial Paste:=xlValues
'delete no needed row
ws2.Rows(3).Delete
ws2.UsedRange.Columns("C:E").Calculate
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
If Not ActiveSheet.AutoFilterMode Then
ws1.Range("2:2").AutoFilter
End If
End Sub
Related
Completely new to VBA. I basically copied the code below and I am repurposing it.. the code essentially selects a row based on whether a certain cell has a certain value. eg. if K5 is "yes" then select the row "K5" copy and paste into a new worksheet.
I am trying to do something slightly different. I want to select certain cells as opposed to the whole entire row - How do I do this
For example, If K5 is "yes", then select A5:D5 & K5 & I5??
Currently the below code below copys the whole "k5" row and pastes it in sheet 2 if there a "y" that appears in the cell "k5"..
Private Sub CommandButton1_Click()
'Declare variables
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
Dim Cell As Range
Dim RngToDelete As Range
Application.ScreenUpdating = False
'Set variables
Set sht1 = Sheets("To DO")
Set sht2 = Sheets("Ongoing")
Set sht3 = Sheets("Done")
'Select Entire Row
'Selection.EntireRow.Select
'Move row to destination sheet & Delete source row
lastRow1 = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row
lastRow2 = sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row
lastRow3 = sht3.Range("A" & sht3.Rows.Count).End(xlUp).Row
With sht2
' loop column H untill last cell with value (not entire column)
For Each Cell In .Range("H2:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
If Cell.Value = "Not started" Then
If RngToDelete Is Nothing Then
Set RngToDelete = Cell
Else
Set RngToDelete = Union(RngToDelete, Cell)
End If
lastRow1 = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row
' Copy>>Paste in 1-line (no need to use Select)
.Rows(Cell.Row).Copy Destination:=sht1.Rows(lastRow1 + 1)
'.Rows(Cell.Row).Delete
ElseIf Cell.Value = "Closed" Then
If RngToDelete Is Nothing Then
Set RngToDelete = Cell
Else
Set RngToDelete = Union(RngToDelete, Cell)
End If
lastRow3 = sht3.Range("A" & sht3.Rows.Count).End(xlUp).Row
' Copy>>Paste in 1-line (no need to use Select)
.Rows(Cell.Row).Copy Destination:=sht3.Rows(lastRow3 + 1)
'.Rows(Cell.Row).Delete
End If
Next Cell
End With
If Not RngToDelete Is Nothing Then RngToDelete.EntireRow.Delete
Application.CutCopyMode = 0
Application.ScreenUpdating = True
MsgBox "Update Done!"
End Sub
I tried to implement the below (ignore the actual cells being copied, the concept of multiple cells instead of the entire row is what im after - sourced from Select multiple ranges with VBA), which seems to work if I use it on its own, but im not able or sure where to implement it in the code above to do what I want it to do.
set rng = Union(.Range("A84:B" & LastRow),.Range("D84:E" & LastRow),.Range("H84:J" & LastRow))
Thanks for your time
Here's one way to do it:
Private Sub CommandButton1_Click()
Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
Dim Cell As Range, e, rngDest As Range
Dim RngToDelete As Range, wsDest As Worksheet
Application.ScreenUpdating = False
Set sht1 = Sheets("To DO")
Set sht2 = Sheets("Ongoing")
Set sht3 = Sheets("Done")
For Each Cell In sht2.Range("H2:H" & _
sht2.Cells(sht2.Rows.Count, "H").End(xlUp).Row).Cells
Select Case Cell.Value 'check the row...
Case "Not started": Set wsDest = sht1
Case "Closed": Set wsDest = sht3
Case Else: Set wsDest = Nothing
End Select
If Not wsDest Is Nothing Then 'any row to copy?
BuildRange RngToDelete, Cell 'build up the delete range
Set rngDest = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
For Each e In Array("A1:D1", "K1", "I1") 'array of cells/ranges to copy, in order
With Cell.EntireRow.Range(e) '#note Range() is *relative* to EntireRow
.Copy rngDest 'copy this cell/area
Set rngDest = rngDest.Offset(0, .Columns.Count) 'next paste destination
End With
Next e
End If
Next Cell
If Not RngToDelete Is Nothing Then RngToDelete.EntireRow.Delete
Application.CutCopyMode = 0
Application.ScreenUpdating = True
MsgBox "Update Done!"
End Sub
'utility sub for building up a range
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
If rngTot Is Nothing Then
Set rngTot = rngAdd
Else
Set rngTot = Application.Union(rngTot, rngAdd)
End If
End Sub
I'm using code below to copy rows from Sheet1 to Sheet2.
I have 3 questions about.
Why this function always copy row A2? Even if value is "0".
How to copy just value, no formatting?
Is it possible to skip column B when copy? "C" from Sheet1 will be "B" in Sheet2, etc.
Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")
With ws1
'assumung that your data stored in column A:D, Sheet1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2:D" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter
.AutoFilter Field:=4, Criteria1:=">0"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.CopyDestination:=ws2.Range("A2")
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False End Sub
I manage to modify like below. Still have issue with range in Worksheet "ws1". Cannot set filter in second row and copy range from row 3. That is why added: "ws2.Rows(3).Delete". Code always copy row 1.
Row 1 got some comments.
Row 2 got column names.
Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")
With ws1
'assumung that data stored in column C:E, Sheet1
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
'can not make range from row 3 ???
Set rng = .Range("C1:E" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter with criteria in column 3 of range C:E
'can not make filter in row 2 ???
.AutoFilter Field:=3, Criteria1:=">0"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Range("A:C").Copy
'paste from row 3
ws2.Range("A3").PasteSpecial Paste:=xlValues
'delete no needed row
ws2.Rows(3).Delete
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
If Not ActiveSheet.AutoFilterMode Then
ws1.Range("2:2").AutoFilter
End If
End Sub
Try this quick fix, assuming your headers on both sheets are in the first row:
Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")
With ws1
'assumung that your data stored in column A:D, Sheet1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:D" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter
.AutoFilter Field:=4, Criteria1:=">0"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Range("A:A,C:D").Copy
ws2.Range("A1").PasteSpecial Paste:=xlValues
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub
To answer your questions:
Why this function always copy row A2? Even if value is "0".
That's because you have set a range starting from the second row and applied a filter to it.
We can change that in the code through setting the range from A1:D & Lastrow and also paste it to ws2.Range("A1").
How to copy just value, no formatting?
Yes it's possible, but you'll need to copy and paste as xlValues as explained by #Peh here
The change in code therefore is to .Copy a range and in the next line .PasteSpecial the xlValues.
Is it possible to skip column B when copy? "C" from Sheet1 will be "B" in Sheet2, etc.
Yes instead of copying the whole range, we can specify which columns you would want to copy, this can be a non-contiguous range of columns.
We can change the .Copy part to include only these specific columns we need.
I'm sure the whole thing can be written neater but this should at least do what you are after.
My code filters one column then prints.
I need to filter based on two columns and then print. I.e. filter based on engineer name (column 1) and route (column 2). Right now, it filters on engineer name (column 1).
Option Explicit
Sub filterandprint()
Dim TempWks As Worksheet
Dim wks As Worksheet
Dim myRng As Range
Dim myCell As Range
'change to match your worksheet name
Set wks = Worksheets("Table")
Set TempWks = Worksheets.Add 'creates temporary worksheet
wks.AutoFilterMode = False 'remove the arrows
'assumes headers only in row 1, columns(1) will be the number of the column you base your filtering
'this copies the unique filtering and pastes it on a new temp worksheet
wks.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=TempWks.Range("A1"), Unique:=True
With TempWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With
'looping
With wks
For Each myCell In myRng.Cells
.UsedRange.AutoFilter Field:=1, Criteria1:=myCell.Value
'.UsedRange.AutoFilter Field:=2, Criteria1:=myCell.Value
.PrintOut Preview:=True
Next myCell
End With
Application.DisplayAlerts = False
TempWks.Delete 'deletes temporary worksheet
Application.DisplayAlerts = True
End Sub
For anyone else searching for an answer, edited the above looping section to the below and it worked:
...
Dim iLoop As Integer
'looping
With wks
For iLoop = 2 To 65
.UsedRange.AutoFilter Field:=1, Criteria1:=TempWks.Cells(iLoop, 1).Value
.UsedRange.AutoFilter Field:=2, Criteria1:=TempWks.Cells(iLoop, 2).Value
.PrintOut Preview:=True
Next iLoop
End With
Application.DisplayAlerts = False
TempWks.Delete 'deletes temporary worksheet
Application.DisplayAlerts = True
End Sub
I've tried multiple codes without luck. I have an excel sheet with 1800 rows and the following columns: ProgramCode, StudyBoard, FacultyID and ProgramType.
In the StudyBoard column there are some cells that are empty. I will then find all the empty cells in StudyBoard and their corresponding information from the other columns. Once I've found the desired cells, they must be overwritten in a new sheet.
I have the following codes, and couldn't continue, because even what I try isn't working.
Dim ws As Worksheet
Dim StudyBoardCol As Range
Dim PromgramCodeCol As Range
Dim rndCell As Range
Dim foundId As Variant
Dim msg As String
Dim FacultyIdCol As Range
Dim ProgramTypeLetter As Range
Set ws = ThisWorkbook.Worksheets("SSBB")
Set StudyBoardCol = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set ProgramCodeCol = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
Set FacultyIdCol = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
Set ProgramTypeLetter = ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
For i = 2 To 1800
Set rndCell = StudyBoardCol.Cells(Int(Rnd * StudyBoardCol.Cells.Count) + 1)
FacultyIdCol = Application.Match(rndCell.Value, ProgramCodeCol, 0)
ProgramTypeLetter = Application.Match(rndCell.Value, ProgramCodeCol, 0)
You could use SpecialCells to “isolate” blank ones
Dim cell As Range
Dim newSheet As Worksheet
Set newSheet = Sheets.Add
With ThisWorkbook.WorkSheets("SSBB") ‘reference “SSBB” sheet
For Each cell in .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeBlanks) ‘ loop through referenced sheet column A blank cells from row 2 down to last not empty one
cell.Resize(,3).Copy destination:=newSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1) ‘ copy range next to current cell and paste to newSheet column A first empty cell
Next
End With
Or use Autofilter (you probably want to add a test that cells are present to be copied before attempting to set rng
Option Explicit
Public Sub TransferBlankStudyBoard()
Dim rng As Range
With ThisWorkbook.Worksheets("SSBB").UsedRange 'Or limit to columns A:D
.AutoFilter
.AutoFilter Field:=1, Criteria1:="="
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).EntireRow.Delete
.AutoFilter
End With
End Sub
I need a macro that need to filter a column and to take out the required date value along with the cell position (i.e say "4/22/2018" cell position "A9 or just 9"). Kindly help me out to fix this issue
See the code that I wrote below
Dim Date As String
Date = Sheets("alldata")
Rows("3:3").Select.AutoFilter.Range("$A$3:$AA$606").AutoFilter , Field:=1, Criterial:="#VALUE!"
Range("A3").Select.xlFilterValues.offset(1, 0).Copy.value
Sheets("Log").Cells(2, "AF").value = Date
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("alldata")
With ws
Set rng = .Range("$A$3:$A$606")
'~~> Remove any filters
.AutoFilterMode = False
With rng
.AutoFilter Field:=1, Criteria1:="<>#VALUE!"
'~~> Get the Row Number
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Row
'~~> Get The cell Address
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Address
'~~> Get the Date
Sheets("Log").Cells(2, "AF").Value = _
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
End Sub
The following will filter the dates and for each date it will copy the value into Sheet Log in Column AF:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("alldata")
Dim wsLog As Worksheet: Set wsLog = Sheets("Log")
'declare and set your worksheet, amend as required
Dim LastRow As Long, LogLastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim c As Range, rng As Range
ws.Rows("3:3").AutoFilter
ws.Range("$A$3:$AA$" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "01/01/2018")
Set rng = ws.Range("$A$4:$A$" & LastRow).SpecialCells(xlCellTypeVisible)
For Each c In rng
LogLastRow = wsLog.Cells(wsLog.Rows.Count, "AF").End(xlUp).Row
c.Copy Destination:=wsLog.Cells(LogLastRow, "AF")
'if instead of copying the value, you want to return its address,
'you can get the address by using "c.Address" for each value in the range
Next c
End Sub