I am trying to get the returns of a stock after each close date and list it in a column. My problem is that the start and end dates change and any cell that is not used for returns has to be completely cleared of contents. Here is what I have so far.
Sheets("returns").Range("a2").FormulaR1C1 = _
"=IFERROR(returns(Imported!RC[4],Imported!R[1]C[4]),"""")"
Sheets("returns").Range("a2").Select
Selection.AutoFill Destination:=Range("a2:a937")
Range("a2:a937").Select
Sheets("returns").Range("c2").FormulaR1C1 = _
"=IFERROR(returns(Imported!RC[10],Imported!R[1]C[10]),"""")"
Sheets("returns").Range("C2").Select
Selection.AutoFill Destination:=Range("c2:c937")
Range("C2:C937").Select
This works for what I need but it leaves a formula in the empty cells which I can't have for the next step of my project. It also leaves a -1 return in the last row when I run out of data. The -1 return isn't too big of a deal if that can't be fixed. Is there a way to clear the contents of a cell that doesn't contain a value but contains a formula?
Here’s what I think you want…
You have data in worksheet “Imported”
You want formulas in worksheet “returns” for the same number of rows that exist in worksheet “Imported”
Sub addFormulasBasedOnRecordCount()
' ========================================================
' jdoxey
' Version 1.0
' ========================================================
Dim wsWithData As Worksheet ' the name of the worksheet that has the data
Dim wsFormulas As Worksheet ' the name of the worksheet that you want the formulas in
Set wsWithData = Worksheets("imported") ' change the "name" to be what you want
Set wsFormulas = Worksheets("returns") ' change the "name" to be what you want
Dim activeRows As Long ' this will be the number of rows that have data
' gets the number of rows in "wsWithData",
' assumes that the data starts in "A1"
' and there are no empty rows
activeRows = wsWithData.Range("A1").CurrentRegion.Rows.Count
' puts the formula into column A starting with row 2 though the number of rows in "wsWithData"
wsFormulas.Range("A2:A" & activeRows). _
FormulaR1C1 = "=IFERROR(returns(Imported!RC[4],Imported!R[1]C[4]),"""")"
' puts the formula into column C starting with row 2 though the number of rows in "wsWithData"
wsFormulas.Range("C2:C" & activeRows). _
FormulaR1C1 = "=IFERROR(returns(Imported!RC[10],Imported!R[1]C[10]),"""")"
' ========================================================
' ========================================================
End Sub
Related
I am trying to copy and paste a range in values without using the clipboard, below code works but doesn't copy in values (includes forumlas etc):
any ideas as how to make this work?
NbRowsPnLD1 = PnLD1WS.Range("A1").End(xlDown).Row
PnLD1WS.Range(PnLD1WS.Cells(1, 1), PnLD1WS.Cells(NbRowsPnLD1, 228)).Copy(PnLD2WS.Cells(1, 1)).PasteSpecial xlPasteValues
Copy the Values of a Range by Assignment
Option Explicit
Sub CopyByAssignment()
' It is assumed that 'PnLD1WS' and 'PnLD2WS' are the code names
' of two worksheets in the workbook containing this code.
' Calculate the last row,
' the row with the last non-empty cell in the column.
' Most of the time you want to use '.End(xlUp)' instead:
Dim slRow As Long
slRow = PnLD1WS.Cells(PnLD1WS.Rows.Count, "A").End(xlUp).Row
' ... because if you have empty cells in the column, it will reference
' the whole range regardlessly.
' The following will 'stop' at the first empty cell and may not reference
' the whole desired column range.
'slRow = PnLD1WS.Range("A1").End(xlDown).Row ' not recommended
' Reference the source range (the range to be copied from).
Dim srg As Range
Set srg = PnLD1WS.Range("A1", PnLD1WS.Cells(slRow, "HT"))
' Reference the destination range (the range to be written (pasted) to).
' Use 'Resize' to make it the same size as the source range.
Dim drg As Range
Set drg = PnLD2WS.Range("A1").Resize(srg.Rows.Count, srg.Columns.Count)
' Copy by assignment.
drg.Value = srg.Value
End Sub
Something like
With PnLD1WS.Range(PnLD1WS.Cells(1, 1), PnLD1WS.Cells(NbRowsPnLD1, 228))
PnLD2WS.Cells(1, 1).Resize(.Rows.Count,.Columns.Count).Value2 = .Value2
End With
I am trying to find text based on a common phrase. The thing is, the text that I will need to copy out is below the text that I will be searching. For example:
7. Amazon emailed seller
Friday, February 2, 2018
"Amazon emailed seller" will be consistent, but I need the date that is below it.
Another example:
Claim Amount:
14.97
"Claim Amount:" will be consistent, but I need the amount that is below it.
In the end I am wanting to create a macro (or VBA function if macro is not possible, I apologize for not knowing) that will allow me to search on "Claim Amount:"/"Amazon emailed seller" or another common phrase and will then move the contents of the cell below them to another cell in another workbook. I will not have a cell location for the search to reference because the information I am exporting pastes differently into Excel each time.
Please let me know if you have any questions or if I should clarify anything. I am new to this website and not exactly sure how to phrase my question to be as clear as possible. My apologies in advance.
Thank you!
Here is a fast approach using a
A) datafield array instead of a Range (base data assumed in column A).
B) All found results are written back to a pair of columns that you can change to any other range or a new workbook.
Code
Option Explicit
Sub extract()
' declare and assign variables
Dim header()
header = Array("Amazon emailed seller", "Claim Amount") ' headers
Dim ws As Worksheet ' sheet object (objects have to be SET)
Dim v ' variant datafield array
Dim i As Long, ii As Long, h As Long, n As Long ' counters
Set ws = ThisWorkbook.Worksheets("MySheet") ' << change to your sheet name
n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row ' get last row in column A
' A) create datafield array and loop through items
v = Application.Transpose(ws.Range("A1:B" & n).Value) ' fill 1-based 2-dim datafield array (TWO Columns!)
For i = 1 To n ' loop through array "row"-items
For h = LBound(header) To UBound(header) ' loop through header items
If InStr(v(1, i), header(h)) Then ' check search string against base text
ii = ii + 1 ' increment array counter
v(1, ii) = v(1, i): v(2, ii) = v(1, i + 1) ' enter found values (both rows)
End If
Next h
Next i
ReDim Preserve v(1 To 2, 1 To ii) ' redimension array to actual items count
' -------------------------------------------
' B) Write back results (e.g. in columns D:E) ' << change to ANY wanted pair of columns
' -------------------------------------------
ws.Range("D:E") = "" ' clear columns D:E to get result
ws.Range("D1:E" & ii) = Application.Transpose(v) ' write summary back to columns D:E
' C) Clear memory
Set ws = Nothing
End Sub
This assumes that you know that the text you are looking for will appear somewhere in A1:A20.
=INDEX(A1:A20,MATCH("Claim Amount:",A1:A20,0)+1)
If you do not know which column the text will appear in, you will need to do a match for each possible column OR change your approach (perhaps a helper column).
you could filter all the database in one shot on wanted headers and then get the cells on row below filtered ones
Option Explicit
Sub main()
Dim dataToKeep As Range
Dim headers As Variant
headers = Array("*Amazon emailed seller", "Claim Amount*") 'list your headers (see asterisks for wild characters)
With Worksheets("mySheetName") ' change "mySheetName" to your actual sheet name
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 'reference its column A cells from row 1 down to last not empty one
.AutoFilter Field:=1, Criteria1:=headers, Operator:=xlFilterValues ' filter reference cells on wnated headers
If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then Set dataToKeep = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Offset(1) ' if any filtered cell then get their underlying cells
End With
.AutoFilterMode = False
End With
If Not dataToKeep Is Nothing Then
' code to handle all data underlying the searched "header" cells
End If
End Sub
I'm working on a macro to copy certain rows (if column A isn't blank) of worksheet 'A' to worksheet 'B'. After a little bit of research the following code suddenly appeared. Only thing that I don't seem to work out is to copy the cell values instead of the linked formula, I tried to implement the 'copy/paste special' command, but I don't get the specific coherent code language.
Sub Samenvattend()
'
' Samenvattend Macro
'
' Sneltoets: Ctrl+Shift+S
'
Dim a As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("gedetailleerde meetstaat")
Set Target = ActiveWorkbook.Worksheets("samenvattende meetstaat")
j = 1 ' Start copying to row 1 in target sheet
For Each a In Source.Range("A1:A10000") ' Do 10000 rows
If a <> "" Then
Source.Rows(a.Row).Copy Target.Rows(j)
j = j + 1
End If
Next a
End Sub
Thanks :)
If you're just trying to set the values of two cells equal, you can skip copy/paste, and simply set the ranges' values equal to one another.
This also lets you skip using the Clipboard and tends to be a little faster.
Just remember when doing this, it's [DESTINATION range].value = [ORIGIN range].value whereas with copy/paste, it's [ORIGIN range].copy [DESTINATION range].
For Each a In Source.Range("A1:A10000") ' Do 10000 rows
If a <> "" Then
Target.Rows(j).value = Source.Rows(a.Row).Value
j = j + 1
End If
Next a
What i am trying to do is look into another excel sheet and pick out information from the rows that have the same string as another in a different sheet. I need to loop though the list and pick out only a few values from the rows. I am still a long shot from achieving this so first im just looking into the sheet1 trying to compare it to the other cell in sheet2.If they have the same value i want to pick out certain cell value in the row where they find the same value and then put them into the other sheet. Apologies if this does not make sense. Here is my code so far. Also i get an error 'object defined when i run the code. When i debug its the line with the if statement thats going wrong
Sub Awesome_macro()
Dim x As Integer
Dim Counter As Integer
' Set numrows = number of rows of data.
NumRows = Range("H15", Range("H15").End(xlDown)).Rows.Count
' Select cell a1.
Range("H16").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
If StrComp(Sheets("Sheet1").Cells(H, 15).Value, Sheets("Sheet2").Cells(A, 1).Value) = 0 Then
Sheets("Sheet1").Range("D15").Copy Destination:=Sheets("Sheet2").Range("B2")
End If
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
Try following piece of code:
Value2Find = Sheets("Sheet2").Cells(A, 1).Value
Row_Num = Sheets("Sheet1").Range("A:A").Find(What:=Value2Find, LookIn:=xlValues).Row
I kind of found a way to to it but its not looping through correctly
Sub Awesome_macro()
Dim x As Integer
Dim Counter As Integer
' Set numrows = number of rows of data.
NumRows = Range("H15", Range("H15").End(xlDown)).Rows.Count
' Select cell a1.
Range("H16").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
If (Sheets("Sheet1").Range("H15").Value = Sheets("Sheet2").Range("A1").Value) Then
Sheets("Sheet1").Range("D15").Copy Destination:=Sheets("Sheet2").Range("B3")
End If
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
Its printing something into the sheet2 now so the comparing the values and printing on the page works. just need to figure out how to loop it properly
how to copy & paste the data from one column to another between two sheets of excel workbook ... without overwriting the destination column content?
I am using below code to copy & paste but every time I run it it is overwriting the existed content. I want to be pasted from next row of the column.
Sub DirectCopySample()
Application.ScreenUpdating = False
Sheets("Updating Sheet").Range("A:A").Copy Destination:=Sheets("Sheet1").Range("G:G")
Sheets("Updating Sheet").Range("B:B").Copy Destination:=Sheets("Sheet1").Range("F:F")
Sheets("Updating Sheet").Range("C:C").Copy Destination:=Sheets("Sheet1").Range("B:B")
Application.ScreenUpdating = True
End Sub
Don't copy the entire column. Copy a specific 1-cell-wide range of X rows (where X is your data) and define all your variables based on the current size of the data. For instance if you want to copy column A from sheet1 to the end of column B in sheet2.
Sub CopyColumn()
Dim wsCopy As Worksheet
Set wsCopy = Sheets("<Sheet Name>")
Dim wsPaste As Worksheet
Set wsPaste = sheets("<Sheet Name>")
'/ Much better to make your worksheets variables and then reference those
Dim lngFirstRow As Long
Dim lngFinalRow As Long
Dim lngCopyColumn As Long
Dim lngPasteColumn As Long
Dim rngCopy As Range
Dim rngPasteCell As Range
lngCopyColumn = 1 '/ ("A" Column)
lngDestinationColumn = 2 '/ ("B" Column)
wsCopy.Activate
lngFirstRow = 1
lngFinalRow = Cells(1048576, lngCopyColumn).End(xlUp).Row
'/ Starts at the bottom of the sheet, stops at the first cell with data in it, returns that cell's row
Set rngCopy = Range(Cells(lngFirstRow, lngCopyColumn), Cells(lngFinalRow, lngCopyColumn))
'/ Defines the range between those 2 cells
rngCopy.copy
wsPaste.Activate
lngFinalRow = Cells(1048576, lngPasteColumn).End(xlUp).Row
Set rngpaste = Cells(lngFinalRow + 1, lngPasteColumn)
'/ Pastes to the row 1 cell below the last filed cell in Column B
rngpaste.Paste
End Sub
#Grade 'Eh' Bacon outlined the correct process in his or her comment.
The crux of the issue is finding the size of the ranges you are copying from and pasting to. My current favorite method of doing so is the code snippet below:
copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
That will find the last non-empty row in your worksheet. So if for some reason column A has 100 rows, B has 200 rows, and C has 300 rows it will return 300 as the last row.
On the paste side of things, you could use the same method and add 1 to it so you paste into the first empty row, but if the columns have different numbers of rows you will end up with many blank rows in the shorter columns before your data is pasted at the bottom.
A work around this is the following code:
pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
This will start at the bottom of column G and head up until it hits a row with data in it and then add 1 so that you are pasting into the first blank row of the column. You could then create variables for columns H and I that do the same thing.
Putting it all together your code would look something like this in the end:
copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
'pasteLastrowH ...
'pasteLastrowI ...
Sheets("Updating Sheet").Range("A2:A" & copyLastrow).Copy Destination:=Sheets("Sheet1").Range("G" & pasteLastrowG)
'Copy and paste B code here
'Copy and paste C code here