How can I dynamically extend the number of rows in two columns that I need to copy to another sheet?
First, I identify the number of rows I need to include and store in totrows:
Dim totrows As Integer
With ThisWorkbook.Worksheets("Sheet1")
totrows = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Next, I am trying to extend the two columns of interest ("B" and "G") so that the range includes that totrows rows. For a static example, if totrows=100 then I would have:
With ThisWorkbook.Worksheets("Sheet1")
.Range("B2:B102,G2:G102").copy
End With
I then paste them into my second sheet with:
ThisWorkbook.Worksheets("Sheet2").Range("A2").Paste
.Range("B2:B102,G2:G102").copy
can be written as
.Range("B2:B" & totrows & ",G2:G" & totrows).Copy
Another way without using .Copy or .Paste would be this:
Sub Copy()
Dim wb As Workbook
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim totrows As Integer
Set wb = Workbooks("Book1.xlsm")
Set wsCopy = wb.Worksheets("Sheet1")
Set wsPaste = wb.Worksheets("Sheet2")
totrows = wsCopy.Range("A" & wsCopy.Rows.Count).End(xlUp).Row
wsPaste.Range("A1:B" & totrows) = wsCopy.Range("A2:A" & totrows, "G2:G" & totrows).Value
End Sub
This way your directly putting the Values into the Range you want.
Related
Let consider the following piece of code, where I inserted an Excel formula to perform a very simple count.
dim wb as Workbook
dim ws as Worksheet
dim ws_a as Worksheet
set wb = ThisWorkbook
set ws = wb.Worksheets("D")
set ws_a = wb.Worksheets("A")
With ws_a
.Range("c2").Formula = _
"ROWS(UNIQUE(FILTER(" & "D"! & Range("c2:c400").Address & "," & _
"IF(" & .Range("a2").Address(0,0) & " =""Empty"","""",""*""& " & .Range("a2").Address(0,0) & " &""*""))"
'following part of code
End With
As you can see, the Range in the Sheet "D" is not dynamic. I'd like to make it dynamic, taking into account the empty cells in the range. Basically, I would need to replace
Range("c2:c400")
with something like
D.Range("c2"),D.Cells(D.Range("c2").SpecialCells(xlCellTypeLastCell).Row, 3))
In the attempt of concatenating strings, I definitely get lost with & and "", so I think this is the problem: my poor knowledge of this type of syntax.
I've also tried to dim and set the range needed (outside the formula), but the code refers to the wrong sheet, as if it could not identify different sheets in the formula.
Dim wb as Workbook, ws as Worksheet, ws_a as Worksheet
Set wb = ThisWorkbook: Set ws = wb.Worksheets("D"): Set ws_a = wb.Worksheets("A")
Dim rngFilter as Range: Set rngFilter = ws_a.Range("c2:C400")
Set rngFilter = Range(rngFilter.Cells(1), rngFilter.SpecialCells(xlCellTypeLastCell))
With ws_a
.Range("c2").Formula = _
"ROWS(UNIQUE(FILTER(" & rngFilter.Address & "," & _
"IF(A2 =""Empty"","""",""*""& A2 &""*""))"
'following part of code
End With
I am trying to concatenate two columns and paste them into another worksheet in the same workbook. There is a complication in that I have to do this for a predefined range of rows, not the whole column. I have managed to get one column copied over as follows, but I am not sure how to extend this to the concatenation of two columns.
Sub Write_Rows(StartRow As Integer, EndRow As Integer)
Dim CopySheet As Worksheet, PasteSheet As Worksheet
Set CopySheet = Sheets("Sheet1")
Set PasteSheet = Sheets("Master") 'I already made this sheet
CopySheet.Range("B" & StartRow, "B" & EndRow).Copy PasteSheet.Range("A2")
End Sub
What I'm trying to do is exactly like the accepted answer in this question but in Excel not Google Spreadsheets.
You can do this via an array formula, then remove the formula and fix the values. Supposing you want to concatenate columns B and C:
Sub Write_Rows(StartRow As Integer, EndRow As Integer)
Dim dest As Range: Set dest = Sheets("Master").Range("A2:A" & 2 + EndRow - StartRow)
Dim src1 As Range: Set src1 = Sheet1.Range("B" & StartRow & ":B" & EndRow)
Dim src2 As Range: Set src2 = src1.Offset(0, 1)
dest.FormulaArray = "=" & src1.Address(External:=True) & "&" & src2.Address(External:=True)
dest.Value = dest.Value
End Sub
i have 2 sheeets. basically ws1 is the destination, ws2 is the source. then i have 2 criterias, an ID Number, and a name of the person who will work on the ID Number.
source contains a row with new actions/progress done by "working person" and need to paste it on the destination in order to update it.
I've read around and saw that autofilter looks like the way to go. i have a code here that autofilters, but i'm just not sure how i can "attack" the problem.
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currow As Long, lastrowSrc As Long
Dim critvalue1 As String
'Destination sheet (dashboard)
Set ws1 = Sheets("Destination")
'Source Sheet (source)
Set ws2 = Sheets("Source")
lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row
For currow = 2 To lastrowSrc
critvalue1 = ws2.Range("E" & currow).Value
ws1.Range("A1").AutoFilter field:=5, Criteria1:=critvalue1
Next currow
end sub
is there an easy way to copy the row from source to destination provided that the IDnumber matches? (the IDnumber is unique)
the code above filters but i'm not sure of how to copy or move the rows.
thanks in advance.
This could be done with SUMPRODUCT or VLOOKUP but if you are set on VBA then try this
Sub copyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currowSrc As Long, currowDest As Long, lastrowSrc As Long
Dim critvalue1 As String
Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")
lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row
For currowSrc = 2 To lastrowSrc
critvalue1 = ws2.Range("E" & currowSrc).Value
ws2.Cells(6, 5).Value = critvalue1
For currowDest = 2 To lastrowDest
If ws1.Range("E" & currowDest).Value = critvalue1 Then
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
End If
Next currowDest
Next currowSrc
End Sub
I find it easier than dealing with the autofilter. It goes row by row from the source sheet and checks for a match in every row of the destination sheet. If there is a match, the source row in copied to the matching destination row.
To keep formatting instead of
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
use
ws2.Rows(currowSrc).Copy
ws1.Range("A" & currowDest).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
I pulled this out of a larger macro I use and made some changes to make it match your method a little better and I deleted some irrelevant stuff. The variable names are a bit different. I believe this does what you need. Let me know if it gives you trouble.
Don't forget to populate the ID and Name arrays, set the value for the 2 column variables and assign the sheet names before running.
Sub copyByAutofilter()
Dim filterList1 As Variant
filterList1 = Array("ID1", "ID2")
filterCol1 = 1 'or whatever column contains the IDs
Dim filterList2 As Variant
filterList2 = Array("Name1", "Name2")
filterCol2 = 2 'or whatever column contains the names
Dim sourceWB As String
sourceWB = ThisWorkbook.Name
Dim sourceWS As String
sourceWS = "Sheet2"
Dim destinationWB As String
destinationWB = ThisWorkbook.Name
Dim destinationWS As String
destinationWS = "Sheet3"
lastrowSrc = Sheets(sourceWS).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = Sheets(destinationWS).Range("A" & Rows.Count).End(xlUp).Row
Workbooks(sourceWB).Sheets(sourceWS).AutoFilterMode = False
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol1, _
Criteria1:=filterList1, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol2, _
Criteria1:=filterList2, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("A2:O" & lastrowSrc).SpecialCells _
(xlCellTypeVisible).Copy _
Destination:=Workbooks(destinationWB).Sheets(destinationWS).Cells(lastrowDest + 1, 1)
End Sub
One method is by using the Copy method of the Range object. This should generally be avoided though as this overwrites the clipboard. A safer option is to simply use rngDest.Value = rngSrc.Value. Note that for this to work the ranges must be the same size. Here is how this is normally used:
Dim dst As Range
Dim src As Range
Set src = Range("A1:B3") 'Data you want to copy
Set dst = Range("C1") 'First cell in the destination Range
Set dst = dst.Resize(src.Rows.Count, src.Columns.Count) 'Resize to match src
dst.Value = src.Value 'Copy to destination
This method has the benefit of preserving the clipboard!
I do not have 10 reputation, so I'm unable to uploaded images, which would make this much, MUCH easier to explain... i posted a table example over to Mr. Excel forum here: http://www.mrexcel.com/forum/excel-questions/833202-visual-basic-applications-find-non-match-criteria-ws2-copy-criteria-ws1.html
I have two worksheets. I need to find Employee ID's in "Sheet2" that match the Employee ID's in "Sheet1". If "Sheet2" has an ID that is not in "Sheet1", then I need to copy specific cells from the said row of "Sheet2" over to "Sheet1".
On top of that, when copying over, I need to make sure that a whole row inserts for the copied cells in order for the previous $amounts to be in the correct spot (see the post in Mr. Excel). This probably makes no sense. If only I could upload an image...
Option Explicit
Sub CopyNonMatches()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1Range As Range, ws2range As Range
Dim ws1Long As Long, ws2long As Long
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
With ws1
ws1Long = .Range("C" & .Rows.Count).End(xlUp).Row
End With
Set ws1Range = ws1.Range("C3", "C" & ws1Long)
With ws2
ws2long = .Range("C" & .Rows.Count).End(xlUp).Row
End With
Set ws2range = ws2.Range("C3", "C" & ws2long)
'Now I need to compare the ranges 'ws1Range' with 'ws2Range' and if 'ws2Range' has ID's that...
'...are not included in 'ws1Range', then I need to copy over info from Columns A to C from the row that had no match over to 'Sheet1'.
???????????????????
End Sub
Sub CopyNonMatches()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim vIDs1 As Variant, vData As Variant
Dim i As Long
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
vIDs1 = ws1.Range("C2", ws1.Range("C" & Rows.Count).End(xlUp)).Value
vData = ws2.Range("A2", ws2.Range("C" & Rows.Count).End(xlUp)).Value
For i = 1 To UBound(vData, 1)
If IsError(Application.Match(vData(i, 3), vIDs1, 0)) Then
ws1.Rows(8).Insert
ws1.Range("A8:C8").Value = Array(vData(i, 1), vData(i, 2), vData(i, 3))
End If
Next i
End Sub
I have formulas from columns O -> X and need them drag them to last row used. Below is the current code I am using:
Dim wkb As Workbook
Dim wkbFrom As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim path As String, FilePart As String
Dim TheFile
Dim loc As String
Dim Lastrow As Long
Set wkb = ThisWorkbook
loc = shPivot.Range("E11").Value
path = shPivot.Range("E12").Value
FilePart = Trim(shPivot.Range("E13").Value)
TheFile = Dir(path & "*" & FilePart & ".xls")
Set wkbFrom = Workbooks.Open(loc & path & TheFile & FilePart)
Set wks = wkbFrom.Sheets("SUPPLIER_01_00028257_KIK CUSTOM")
Set rng = wks.Range("A2:N500")
'Copies range from report generated to share drive and pastes into the current week tab of open order report
rng.Copy wkb.Sheets("Current Week").Range("A4")
With ActiveSheet
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("O4:X4").AutoFill .Range("O4:X4").Resize(Lastrow)
End With
The code Lastrow is not dragging the formulas down
You can do auto-fill like this in VBA (verified using macro recording)
Range("O1:X1").Select
Selection.AutoFill Destination:=Range("O1:X25"), Type:=xlFillDefault
Now that you have this code as a base to work with you can use any variables you like in the syntax like this:
Range("O1:X1").Select
Selection.AutoFill Destination:=Range("O1:X" & Lastrow), Type:=xlFillDefault
I used this:
Sub sum_1to10_fill()
Sheets("13").Activate
Range("EG12").Copy
Range("EG12:FT36").PasteSpecial xlPasteFormulas
End sub
...and filled up my whole label both down and right.