http://i.stack.imgur.com/93bt7.png
Hi,
I am trying to work with a code I have made but am having some trouble.
If you look at my photo above, in cell B3 I have a CUSIP. What I want to do is copy that CUSIP and paste it in each row of info for that CUSIP (so rows A4 till A8). Then I want to move to the second CUSIP in J3 (the CUSIPS are all in row 3 and 8 columns apart) and then paste the CUSIP in rows J4 to J35.
I want to keep doing this over and over for 1000 securities but the issue is that the rows differ in length.
My code is working until I get to the last piece of code which I have put in as a comment. It works but is static. Only works for moving from the 1st to 2nd security then fails. I am trying to think of a dynamic way for me to move from the cell which the CUSIP is last pasted in to the third row and corresponding column everytime (column will be 9 apart every time from the last pasted cell).
Here it is:
Sub CUSIP_Copy_Paste()
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long
Dim r As Long
Range("B3").Select
LastCol = Cells(4, Columns.Count).End(xlToLeft).column
For c = 2 To LastCol Step 8
LastRow = Cells(Rows.Count, c).End(xlUp).row
ActiveCell.Copy
Cells(4, ActiveCell.Offset(1, -1).column).PasteSpecial xlPasteValues
For r = 5 To LastRow
Cells(r, ActiveCell.Offset(1, 0).column).PasteSpecial xlPasteValues
Next r
''''''ActiveCell.Offset(-5, 9).Select
Next c
End Sub
Thanks!
Your error lies in the final offset. Instead of -5, put in a variable, preferrably the variable which is the difference between the end of the rows count and the beginning, which is always 3.
That is to say, Offset(3 - lastRow, 9)
You almost had it friendo :)
Related
VBA question using Excel 2016 (64 bit)
I have header data in the first two columns (A:B) and the top row (1). I would like to dynamically paste a formula downward, starting from cell C2, to the last row and the last column. The working prototype is as follows:
Dim LstCol As Long
LstCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, "C"), Cells(2, LstCol)).Value = "=INDEX(RC1,MATCH(R1C,RC2,0))"
Dim LstRow As Long
LstRow = Cells(1, Rows.Count).End(xlUp).Row
Range(Cells(2, "C"), Cells(2, LstRow)).Value = "=INDEX(RC1,MATCH(RC1,R2C,0))"
The first Dim works as intended. The formula is successfully deployed throughout the second row to the final column (or perhaps it starts at the last column and moves leftward). However, the second Dim stops on an error. I'm unsure how to spread the data from the last row (to the last column) upwards to the second row (and the corresponding last column).
In my example, the first two columns have header data from 1 to 5330 (A1:B5330). I also have header data in the first row (C1:AX1). My target is to fill the formula =INDEX($A2,MATCH(D$1,$B2,0)) from C2:AX5330 dynamically.
Where am I going wrong?
You need to properly qualify your instances of Range and Cells with a worksheet. You can either directly do this, dim a worksheet variable, or use a With block like so:
Dim LRow as Long
With ThisworkBook.Sheets("????")
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("C2:AX5330").Formula = "=INDEX($A2,MATCH(D$1,$B2,0))" 'Make sure your cell references are correct here
.Range("C2:AX5330").Value = .Range("C2:AX55330").Value 'Place as values instead of formula
End With
I work for a local company that uses antiquated systems relying on much manual data entry. Trying to ease the pain with some faster capabilities using excel vba and formulas. I've built a spreadsheet filled with formulas and vba buttons. I'm literally on the last part and have been stuck now for at least 2 weeks. Time is now running out and I'm hoping for some assistance.
Spreadsheet has 2 sheets named "Sheet1" and "Sheet2". On Sheet1 I use a button to concatenate and move data into one cell which is L11. In L8 I have a constant changing date, day by day. The data entry works like this: I enter data for April 11th and then change the date in L8 to April 14th (could be any day, just using 14 as an example) to enter the next set of data. On Sheet2 I have each column labeled by days in the month, i.e. Column A = 1-Apr, Column B = 2-Apr, Column C = 3-Apr, etc.... to the end of the month 30 or 31 which equals Column AD or AE.
What I'd like for the code to do is move the data from cell L11 on sheet1, based on the date in L8 on sheet1, the data moves from sheet1 to sheet2 under the corresponding date. So the click of a button, the macro/vba code finds the date on sheet2 and looks for the date in L8 sheet1 and says:
"I see a date of 17-Apr in L8, what data exists in cell L11 on sheet1? Ahhh ok.. there is data in L11 sheet1. I will go ahead and take that data from L11 and paste it in column 17(column Q) in the next available slot below. Then I will make sure the data is removed from Sheet1 and put the user back on Sheet1 ready to be used again."
Please keep in mind that the data that exists in L8 sheet1 (the date) contains a vlookup formula. If that is not needed, I'll gladly take other ideas on matching dates. Or for that matter any other ideas that are better than what you see above and below I'm always open to suggestions. Also, the button I use to concatenate data that ultimately ends up in cell L11 sheet1 is a recorded macro. Basically I recorded copying specific cells and pasting them together in one cell and then inserted a single cell that pushes the concatenated data down one cell so that I could enter more than one set of data.
This is the most recent code I've been working on. When I used the loops for i and j, the code did not error out, however it didn't do anything when running. I recently tried adding k and m, but the wall I'm hitting just won't budge. Help please...
Sub senddatatosheet2()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim mydate As String
lastrow1 = Sheets("sheet1").Range("L" & Rows.Count).End(xlUp).Row
For i = 8 To 8
For k = 11 To 11
mydate = Sheets("sheet1").Cells(i, "L").Value
Sheets("Sheet2").Activate
lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To lastrow2
For m = 2 To lastrow2
If Sheets("sheet2").Range(Cells(j, "A")).Value = mydate Then
Sheets("Sheet1").Activate
Sheets("Sheet1").Range(Cells(11, "L")).Copy
Sheets("Sheet2").Activate
Sheets("Sheet2").Range(Cells(j, "A"), Cells(j, "AD")).Select
ActiveSheet.Paste
End If
Next j
Next m
Application.CutCopyMode = False
Next i
Next k
Sheets("Sheet1").Activate
Sheets("sheet1").Range("A1").Select
End Sub
Correct me if I'm wrong...
You enter the date in Sheet1!L8, then enter whatever data you want into whatever cells you do, which is all concatenated into Sheet1!L11.
You want to transfer the data in Sheet1!L11 into say Sheet1!xy (where x=the column for the data to go into for that day and y=the next empty row), who's date is in Sheet1!x1 and it matches the date in Sheet1!L8
If so, the following should do:
Sub btnNext_Click()
Dim MyDate As Date
Dim ColFound As Long, NextRowToUse As Long, MyData As String
Dim RowThatContainsDates As Long
'Enter the row that contains the dates across the top
RowThatContainsDates = 1
'Get the date from Sheet1!L8
MyDate = Sheets("sheet1").Cells(8, 12).Value
'Get the data from Sheet1!L11
MyData = Worksheets("Sheet1").Cells(11, 12).Value
'Get the column where the date in Sheet1!L8 is found
ColFound = Worksheets("sheet2").Rows(RowThatContainsDates).Find(MyDate, LookIn:=xlFormulas, LookAt:=xlWhole).Column
'Get the next row to use for the selected Column
NextRowToUse = 1
Do While Worksheets("sheet2").Cells(NextRowToUse, ColFound).Value <> ""
NextRowToUse = NextRowToUse + 1
Loop
'Duplicate the text from Sheet1!l1 to the Row and Column found
Worksheets("Sheet2").Cells(NextRowToUse, ColFound).Value = MyData
'Clear the contents of the cells containing the original data
Worksheets("Sheet1").Range("L3:L6").ClearContents
End Sub
I am trying to write a code to autofill the final column in a worksheet to the right x times.
I have the code which will pick up the last column :
With ActiveSheet
LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
End With
Columns(LC).Select
and also code that would autofill across if I specify which specific columns
Selection.AutoFill Destination:=Columns("BE:BQ"), Type:=xlFillDefault
What I am struggling with is how to replace the columns "BE:BQ" with the required code which is linked to the original Last Column (LC).
Ideally I would like it to autofill across to add, say 10, new columns. Do you have any advice?
Ideally I would like the code to cycle through all the worksheets in my workbook - but this is probably a bit advanced for me!
Thank you very much in advance.
UPDATE
Thank you for your suggested comments. I have amended the code as below. This firstly appeared to work perfectly. However, I have since come across two issues.
Issue 1 - on some sheets when it fills across a date field which is in row 3 does not fill. It just copies across the date exactly the same as the one in the last row (i.e. 01/06/2017 but is displayed as Jun-17). I would like this to fill across a month at a time.
Issue 2 - in row 2 there is a date which is the last day of the pervious month. This is currently entered manually but as I have developed the macro I would like this to be changed to a formula equal to date in the cell below minus 1 day. I tried to do this using the following formula but it went completely awry!
sht.Cells(2, LC).Formula = "=" & Cells(3, LC) & "-1"
Any advice on how to fix these two issues would be most appreciated.
Dim LC As Integer
Dim LR As Long
ActiveSheet.Unprotect
With ActiveSheet
LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
LR = .Cells(Rows.Count, LC).End(xlUp).Row
End With
Range(Cells(1, LC), Cells(LR, LC)).Select
Selection.AutoFill Destination:=Range(Cells(1, LC), Cells(LR, LC + 10)),Type:=xlFillDefault
Try this. I'm not sure about the A2 bit as the code suggests the autofill starts at row 3 but can jus replace 3 with 2 in the code if it should also be included.
Sub x()
Dim LC As Long, LR As Long, ws As Worksheet
For Each ws In Worksheets
With ws
LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(3, LC), .Cells(LR, LC)).AutoFill Destination:=.Range(.Cells(3, LC), .Cells(LR, LC + 10)), Type:=xlFillDefault
.Cells(3, LC).AutoFill Destination:=.Cells(3, LC).Resize(, 10), Type:=xlFillMonths
.Range("A2").Formula = "=A3-1"
End With
Next ws
End Sub
I've been looking around everywhere. But I don't know what words to google.
I want to remove every row where the cell in the C column doesn't contain 7 or 8 numbers. The problem is that I don't know how to code this.
What is the symbol in VBA code for 1 letter, 1 number, 1 or more letters, 1 or more numbers, space etc? I have been googling for hours but I guess I just don't know the right search words. Where or how can I find this? It's pretty dumb I know.
Thanks a lot.
EDIT:
#eirikdaude Thank you for your answer.
Somehow it doesn't work. This is what I have:
Dim lastRow As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Integer
For i = 2 To lastRow
If (IsNumeric(Cells(i, 3).Value) And Len(Cells(i, 3).Value) >= 7 And Len(Cells(i, 3).Value) <= 8) Then
' do nothing
Else
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i
I've been trying everything, but I don't understand why this code above doesn't work.
Does it matter that all my cells are formatted "standard" in excel? Because all data is imported from a txt file.
Unless you insist on using a regex for this, I'd simply check for the length of the value in the cell and if it IsNumeric.
In your case, something like this:
For Each c In rangeToCheck
If IsNumeric(c) And Len(c) >= 7 And Len(c) <=8) Then
do your stuff
End If
Next c
There two probably reason for which you code is no deleting the expected rows:
Expected lines to be deleted may be skipped by the code as it's deleting rows from top to bottom. When deleting several rows the correct method is to do it upwards (i.e. from bottom to top)
As your data is imported from a text file it's possible that values in column C have some extra blank spaces at the end. The use of TRIM takes care of this situation.
The code below includes both corrections:
Sub Rng_Delete_Rows()
Dim LRowLst As Long, LRow As Long
Dim vCllVal As Variant
'Change SheetName as required
With ThisWorkbook.Sheets(1) 'Use this if procedure resides in Data workbook
'With ThisWorkbook.Sheets(1) 'Use this if procedure does not reside in Data workbook
Application.Goto .Cells(1), 1
LRowLst = .Cells(.Rows.Count, 3).End(xlUp).Row
For LRow = LRowLst To 2 Step -1
Rem Get Cell Value At Once
vCllVal = Trim(.Cells(LRow, 3).Value2)
If Not ((IsNumeric(vCllVal) _
And Len(vCllVal) >= 7 And Len(vCllVal) <= 8)) Then
Rem Delete Row
.Rows(LRow).EntireRow.Delete
End If: Next: End With
End Sub
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