My table contains variable number of rows and three columns (A:C) that I am interested in
A B C D
1 xx xx xx xxx
2 ....
3 ....
4 ...
I need to copy from WorkSheet1 to WorkSheet2
ws2.Range("A1").Value = ws1.Range("A1:C4").Value
The problem is that I do not want to hardcode C4 , because it can be C5 or C20 . How can I account for possible variable number of rows.
PS : I cannot use Range("A1").CurrentRegion because this will select more columns than needed, i.e. column D values will also get selected. Although it will select the correct number of rows
There is more than one solution to most problems, but since CurrentRegion method returns the right number of rows (but the wrong number of columns), you could do something like this assuming you always need THREE columns.
Dim rng as Range
Set rng = ws1.Range("A1").CurrentRegion.Resize(,3)
ws2.Range(rng.Address).Value = rng.Value
I'm making an assumption that the last row in D will be equal to or less than the last row of A:C. I'm also assuming that the last row is determined by the last row that contains data.
Sub CopyColumnAtoC()
Dim lastRow As Long
lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ThisWorkbook.Worksheets(1).Range("A1:C" & lastRow).Copy
ThisWorkbook.Worksheets(2).Range("A1:C" & lastRow).PasteSpecial xlPasteValues
End Sub
You can specify just columns in a range. So
Sheet2.Range(Sheet1.Range("A:C").Address).Value = Sheet1.Range("A:C").Value
will copy columns A through C regardless of the rows in each column, i.e. if Column A has 8 rows, B has 6, and C has 11 it will still work.
Related
I have string data in Column A, I have number values in Column B. I also have Columns O to Z which are currently blank - these columns have headers 1, 2, 3 etc. (i.e. cell references O2=1, P2=2, Q2=3 etc.)
There is a number value in cell C1.
If C1 = matches any of the column headers (O-Z) then copy the data from Column B to the corresponding column.
Example: If C1 = 4 and cell R2 is 4, the data from Column B would populate in Column R.
How do I achieve this with VBA? Thanks in advance.
Try something like this...
Sub CopyDataDynamically()
Dim lr As Long, num As Long
Dim rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("O2")
num = Range("C1").Value
If num > 0 And num <= 12 Then
Range("B2:B" & lr).Copy
rng.Offset(0, num - 1).PasteSpecial xlPasteValues
End If
End Sub
If you want to achieve this with the help of a formula, try this...
In O2
=IF($B2="","",IF(O$1=$C$1,$B2,""))
and then copy it across and down as far as there is data in column B.
I'm currently running a macro which identifies duplicates in a workbook, however it identifies the first set off the index and doesn't tag the first set then which has led to me setting up a if statement to by pass this, which adds duplicate to the first instance too. This is taking a long time to do however and would like to improve this, if possible. Any suggestions would be greatly appreciated, I am new to VBA but have been learning bits as I've encountered new problems!
'Declaring the lastRow variable as Long to store the last row value in the Column1
Dim lastRow As Long
'matchFoundIndex is to store the match index values of the given value
Dim matchFoundIndex As Long
'iCntr is to loop through all the records in the column 1 using For loop
Dim iCntr As Long
Dim first_dup As Long
Dim tagging As Long
Dim item_code As String
'Finding the last row in the Column 1
lastRow = Range("B1000000").End(xlUp).Row
'
'looping through the column1
For iCntr = 2 To lastRow
'checking if the cell is having any item, skipping if it is blank.
If Cells(iCntr, 1) <> "" Then
'getting match index number for the value of the cell
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
'if the match index is not equals to current row number, then it is a duplicate value
If iCntr <> matchFoundIndex Then
'Printing the label in the column B
Cells(iCntr, 4) = "Duplicate"
End If
End If
Next
For first_dup = 2 To lastRow
If Cells(first_dup, 5) = "Duplicate" Then
item_code = Cells(first_dup, 1)
For tagging = 2 To lastRow
If Cells(tagging, 1) = item_code Then
Cells(tagging, 5) = "Duplicate"
End If
Next
End If
Next
Example data:
item code
1
2
3
4
1 duplicate
2 duplicate
3 duplicate
4 duplicate
1 duplicate
2 duplicate
3 duplicate
4 duplicate
My first suggestion is not to over-complicate things, try using duplicate values conditional formatting to see if this helps:
Failing that, if you are desperate to find ONLY the duplicates, and not the first occurrence, you can use a formula like this: (In Cell B2 if your Data starts in A2, it will require a header row that doesn't match, or your first row will always match)
=IF(COUNTIF($A1:A$1,A2)>=1,"Duplicate","")
Which when pasted down your row of data could look something like this:
There are also VBA solutions if you are desperate for a VBA solution, but I thought I'd give you the simple ones first. Let me know how you get on in the comments.
Edit: you can just insert the above formula using VBA, with R1C1 notation, e.g.:
Sub test()
Range("B2:B" & Range("A1").End(xlDown).Row).FormulaR1C1 = "=IF(COUNTIF(R1C1:R[-1]C1,RC1)>=1,""Duplicate"","""")"
End Sub
I'll break this down so you know what is happening.
Range("B2:B" & Range("A1").End(xlDown).Row) selects the cells in column B between B2 and the last filled row in column A i.e. Range("A1").End(xlDown).Row (so this won't work if you expect blanks in column A as part of your data)
Then, it sets the R1C1 ref formula to "=IF(COUNTIF(R1C1:R[-1]C1,RC1)>=1,""Duplicate"","""")", where R1C1 means first row, first column, (i.e. $A$1)
R[-1]C1 means previous row, first column. For example,
If you are in B5, this would select A4.
If you are in A2, this would select A1.
If you are in A1, this would error out because you cant be in a row earlier than 1.
And RC1 means current row, first column.
Hope this helps!
The answer was the same as the initial code I presented, it's taking roughly 5 minutes for 30000 items so it isn't too bad at what it does.
I have a data of say more than 5000 rows and 10 columns. I would like to add a text to the rows based on columns conditions.
A B C D
fname lname state clustername
1. ram giri NCE ...
2. philips sohia MAD ...
3. harish Gabari NCE ....
Based on the column state, for NCE the cluster name is "nce.net" has to be assigned to column D (clustername) and also for MAD is "muc.net" to be assigned to row 2.
could you please help me out.
Here is my code:
dim emptyrow as string
row_number = 1
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
state = sheets("sheet1").rows("C" & row_number)
for each cell in selection
if instr(state, "NCE") = true then
Range(Cells(emptyrow, "D").Value = Array("nce.net")
end if
next emptyrow
Could you please help me out.
Why not a simple formula
In D1 and copy down
=IF(C1="NCE","nce.net",IF(C1="MAD","muc.net","No match"))
Doing the same this with code
Sub Simple()
Dim rng1 As Range
Set rng1 = Range([c1], Cells(Rows.Count, "C").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]=""NCE"",""nce.net"",IF(RC[-1]=""MAD"",""muc.net"",""No match""))"
.Value = .Value
End With
End Sub
You may create a reference table consisting of unique state and clustername in a seperate worksheet and then pull the clustername into your original sheet using a =VLOOKUP() function ... provided there is a 1:1 relation between state and cluster ... even 1 cluster for multiple states would work. This way you avoid hardcoding and you can react quickly if cluster names change.
Example:
in Sheet2 list all countries and their associated clusternames
in Sheet1 enter =VLOOKUP(...) into first row of clustername column as per below picture and copy down for all rows
Of course you may want to have values only, not formulas in your cluster column; then you can convert formulas into values by copying and then pasting as values that cluster column after you've entered the =VLOOKUP(...) formula.
Alternatively, if e.g. you have a lot of clusternames already defined and only want to work on rows where clustername is blank, you can
filter for blank clusternames and insert the =VLOOKUP(...) only there
use a small piece of code
Sub DoCluster()
Dim R As Range, S As Integer, C As Integer, Idx As Integer
Set R = ActiveSheet.[A2] ' top left cell of table
S = 3 ' column index of State column
C = 4 ' column index of Clustername column
Idx = 1 ' start at 1st row within range
' run a loop across all rows, stop if 1st column gets blank
Do While R(Idx, 1) <> ""
' work only on rows wher cluster not yet set
If R(Idx, C) = "" Then
' now this isn't really good ... try to avoid hardcoding BY ANY MEANS
Select Case R(Idx, 3)
Case "NCE"
R(Idx, 4) = "nce.net"
Case "MAD"
R(Idx, 4) = "muc.net"
' insert other cases here as per need
' ...
' trap undefined cases
Case Else
R(Idx, 4) = "undefined"
End Select
End If
Idx = Idx + 1
Loop
End Sub
Personally I don't like this kind of hardcoding at all, I'd rather take the clusternames from a table ... so for me there wouldn't be a need to write code unless the whole task is much more complex than described.
Q: I need to simply paste the values of the row at my discretion (button) so that they remain permanently where I pasted them.If they already exist there then update them otherwise paste to the last non empty row. From where they get copied the rows can change , new rows can come and go hence they'd need a unique identifier from the column
The only formula I have for a building block for doing this is:
Function paste() As Variant
macropastec4 = Sheets("Sheet1").Range("I3").Value
End Function
which I could assign to a button to paste the value of the one cell however I need rows and much more (see detailed description) so I don't know whether the right solution would incorp my building block at all!
detailed description:
How can I adjust this formula to paste a row of cells based on a cell value (unique identifier) in that row. I.e incorporating a unique reference in the row ie 1 in A1 in such a way that if I was to run the sub again it would just update the row that exists starting H10 where it has been copied with H10 containing that referred 1. If it was a new row it would populate the last empty row beginning either H12 or H11. I would have push button to run the vba function for each row to be copied so in O1 O2 O3 etc
A B C D E F G to H I J K L M N 1
"non empty cells containing 2
1 1 b c d e f g 8 previously pasted rows from(A:G) 3
2 2 i j k l m n 9 which have now disappeared"
3 3 p q 5 3 y z 10 1 b c d e f g
11 2 i j k l m n
12 3 p q 5 3 y z
The more complicated part lies in that A1 to G1 won't always contain 1,b,c,d,e,f,g but as I paste it to where it should be pasted ie in rows H to N according to my rules and at my discretion ( ie clicking on the vba sub button). At a certain time completely independant of when I run the sub for each row , the row A:Gwill dissapear and repopulate with something new. Moreover it will repopulate with whatever was below A1 to G1 ie A2 to G2 unless A2 to G2 has already disappeared in which case it would populate whatever remains just filling up to A1 to G1 hence why I would need the unique identifier being the 1 in A1 to work after this re-alignment whereby if I run the sub again it would recognize the 1 or the 2 and know its place within H to N again knowing to only update the existing row there (permanently pasted) or otherwise ( if it is a new line that exists ) to paste it to the last empty row under H to N
- i.e new rows can appear in A:G any time moving to the top or bottom
n.b. I only need the ability to paste the cells from A1:G3or further depending on how many rows there are ie it could be A1:G20 but I want the sub to cator for each row independantly through a button. How those rows A1:G20 re-populate and re-order themselves is dependant on of of the columns in the row. Ie they would repopulate if they had a similar column cell but that should be ignored in the framework of what I am trying to achieve, I need only reference to the unique identifiers in column A of the rows
other points
In cells A1 toG1ANDA2toG2` etc (basically every row) I will have a combination of number, letters (written text) and inserted references (LINKS) to sheets in Microsoft onenote. So I'd need the ability to have the same link copied over with the same alignment of the LINK button I have for that particular onenote file i.e aligned to cell etc. So basically just paste whatever is there in those cells!!
It is probably worth noting that the unique identifiers as they
repopulate won't be in any order - they will be completely random i.e
not neceserrily 1,2,3,4, could be 313,2,32131,2,33 but they will be numbers
I will also need this to referece the one sheet I am working on.
Please help me accomplish this! thanks in advance
Don't know if this helps
still no ideas? do these help?
Code:
Sub CopyRows()
Dim LastRow As Long
Dim destRng As Range
Application.ScreenUpdating = False
With Sheets("All Data")
Set destRng = .Range("B" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1)
LastRow = Sheets("IDEAS").Range("C" & Rows.Count).End(xlUp).Row
Sheets("IDEAS").Range("B8:S" & LastRow).Copy Destination:=destRng
.Columns("B:S").AutoFit
End With
Application.ScreenUpdating = True
End Sub
maybe I could have one sub button for all rows to do this. Just need the above to filter for already existing rows with the identifier. :S So I need some form of the above with an if command and to paste values :S
this help:?
Sheets("Sheet1").Range("A1:F48").Copy
With Sheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Use VBA to paste values from one table to another
this with a paste not copy ?
I could reference cells with the currently displayed unique identifiers
Public Sub CopyRows()
Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
ThisValue = Cells(x, 4).Value
If ThisValue = "A" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("SheetA").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ElseIf ThisValue = "B" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("SheetB").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next x
End Sub
I have searched the forums but I am really struggling to get part of my code to work. Basically the idea is to search sheet 1 and copy one or more columns depending on the criteria to a specific worksheet.
i.e. if sheet 1 columns 1 and 3 contain "copy 01" then copy both columns to a sheet 2 and if sheet 1 columns 2 and 4 contain "copy 02" then copy both columns to a sheet 3 etc.
I can count rows fine using the code, but can't count columns. Seems to relate to not fiding the column range but I have no ideas to fix this! Any help would be much appreciated.
'Row
Dim NR As Long
Dim d As Variant
d = ws1.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For NR = 1 To UBound(d, 1)
'column
Dim NC As Long
Dim e As Variant
e = ws1.Range(Cells(1, Columns.Count).End(xlToLeft).Column).Value
For NC = 1 To UBound(e, 1)
Thanks,
Stewart
You want this:
e = range("A1:" & split(cells(1,cells(1,columns.Count).end(xlToLeft).column).address(true,false), "$")(0) & "1").Address
The cells(1, columns.count).end(xlToLeft).column) gets the last column number (for example 13 for 'M').
Putting this into cells(1, lastcolNum) gets a cell that represents the cell in the first row of this column (for example Cell M1).
The address(true, false) method gets the cell reference with a dollar sign before the row but not before the column letter (for example "M$1"
The split function returns an array which splits the input string by the "$" character (for example array - ("M","1")
The (0) returns the 0th element in the returned array (for example "M")
Then putting this into the range function returns the range (for example) "A1:M1"
I'm not entirely sure what you're trying to do with the UBound function here. It would make more sense to make
e = cells(1,columns.count).end(xlToLeft).column
and then loop through
For N = 1 To e
As this will loop through each column.