I've been struggling with this problem for a whole month...
Here is the point. I've got a sheet in excel called Amounts where there are many datas listed under 10 columns from cell A2 to cell J2. The last colum can vary day to day. There are headnames above those different datas that allows me to know the type of data.
Anyway, there are many columns where the header start with the following value Amount of (date). I want to make a code that;
Allows me to search automatically for all the columns'name that starts with the value Amount of
Copy all of the data below (from the first data until the last one). The range of datas under each column can vary from day to day.
And finally paste each of the range data copied under the column header on other sheet and in one single column (starting in cel(1,1)).
Here's how my current code looks like;
Dim cel As Range
With Sheets("Amounts")
Worksheets("Amounts").Activate
For Each cel In Range("A2", Range("A2").End(xlToRight)
If cel.Value Like "Amount in USD *" Then
cel.Offset(1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Worksheets("Pasted Amounts").Range("A2")
End If
Next cel
Could you please help me with this...? I feel like the answer is so obvious like the nose in the middle of my face.
Try this. I have commented the code so you should not have a problem understanding it.
Option Explicit
Sub Sample()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String
'~~> Set your sheets here
Set wsInput = Sheets("Amounts")
Set wsOutput = Sheets("Pasted Amounts")
With wsInput
'~~> Find last column in Row 2
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'~~> Loop through columns
For i = 1 To lCol
'~~> Check for your criteria
If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
'~~> Get column name
Col = Split(.Cells(, i).Address, "$")(1)
'~~> Get the last row in that column
lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
'~~> Find the next row to write to
If lRowOutput = 0 Then
lRowOutput = 2
Else
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
End If
'~~> Copy the data
.Range(Col & "3:" & Col & lRowInput).Copy _
wsOutput.Range("A" & lRowOutput)
End If
Next i
End With
End Sub
Worth a read
How to avoid using Select in Excel VBA
Find Last Row in Excel
Related
I have tried to just set the range to ("A:A") but that makes the table too large and my computer freezes up, I have also tried to input a line like Range("A" & Rows.Count).End(xlUp).Offset(1) but that is not recognized by VBA.
Any help would be appreciated!
You need to first define your last row by referencing the last cell in the column then use .End(xlUp).row to find the last row number. You can then use that row number to build cell references, or even save the range as a range variable like I did:
Sub Last_Row_Example()
Dim LastRow As Long 'Last Row as a long integer
Dim RG As Range 'A range we can reference again and again very easily
'Consider renaming it to something more descriptive.
'for your particular situation
LastRow = Range("A" & Rows.Count).End(xlUp).Row ' Here we store the "LastRow" Number
Set RG = Range("A1:A" & LastRow) ' Here we build a range using the LastRow variable.
RG.Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, RG, , xlYes).Name = _
"Table3"
Range("Table3[[#All],[Ticker Name]]").Select
Selection.ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:= _
"en-US"
End Sub
I've been trying to find a solution for that problem but nothing came up.
Here is the problem I've got. I would like to copy a variable data range from a sheet called ("Amounts") starting in range "C3" to an other sheet called ("Pasted Amounts") in range F2 as many time as columns, in sheets "Amounts" are starting with the following value " Amounts in USD".
I've been coding something but it doesn't work... I put a counter in a cell to count how many time there are columns starting with the value " Amounts in USD" in order to pick the value appearing in that cell and repeat the paste process. But I've been complicated the code I guess...
Here is my code;
Dim cel2 As Range
Dim counter as Integer
With Sheets("Amounts")
Worksheets("Amounts").Activate
For Each cel2 In Range("A2", Range("A2").End(xlToRight))
If cel2.Value Like "Amount in USD*" Then
counter = counter + 1
Range("U4").Value = counter
End If
With Worksheets("Pasted Amounts").Activate
'~Here is bellow the column named " clients name" I want to paste in "Pasted amounts" sheet (by coping it in the sheet "Amounts"
worksheets("Amounts").Range("C3",range("C3").end(xldown).Select
'~ Paste the range copied in sheet " Pasted Amount" as many time the counter value is
.Copy Range("F2").Resize(.Count * counter)
End With
Next cel2
End With
End sub
Once again, I'd appreciate so much your help...
Mido88
Sub test()
Dim LastColumn As Long, LastRow As Long, counter as Long
With Sheets("Amounts")
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
counter = WorksheetFunction.CountIf(.Range("A1", .Cells(1, LastColumn)), "Amount in USD*")
.Range("C3:C" & LastRow).Copy _
Worksheets("Pasted Amounts").Range("F2").Resize(.Range("C3:C" & LastRow).Count * counter)
End With
End Sub
Or as a silly long one line of code:
Sub test()
Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Copy Worksheets("Pasted Amounts").Range("F2").Resize(Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Count * WorksheetFunction.CountIf(Sheets("Amounts").Range("A1", Sheets("Amounts").Cells(1, Sheets("Amounts").Cells(1, Sheets("Amounts").Columns.Count).End(xlToLeft).Column)), "Amount in USD*"))
End Sub
Alright I found the solution!
Thank you again Siddharth and Christofer, your answers helped me a lot to think further...
Here is the solution that worked really well! I used the answer in the previous post I made here:link and added a single line code to paste as many time the range of datas as" Amounts in USD " was found in the previous sheet.
Sorry again for those misunderstandings. I hope that my answer would help you and the other users in need!
Here it is;
Sub Sample()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String
'~~> Set your sheets here
Set wsInput = Sheets("Amounts")
Set wsOutput = Sheets("Pasted Amounts")
With wsInput
'~~> Find last column in Row 2
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'~~> Loop through columns
For i = 1 To lCol
'~~> Check for your criteria
If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
'~~> Get column name
Col = Split(.Cells(, i).Address, "$")(1)
'~~> Get the last row in that column
lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
'~~> Find the next row to write to
If lRowOutput = 0 Then
lRowOutput = 2
Else
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
End If
'~~> Copy the datas ( for each column where Amounts in USD was found)
.Range(Col & "3:" & Col & lRowInput).Copy _
wsOutput.Range("A" & lRowOutput)
~~> SOLUTION BELLOW-Copy the variable data range ("C3")
Worksheets("Amounts").Activate
.Range("C3", Range("C3").End(xlDown)).Copy wsOutput.Range("F" & lRowOutput)
End If
Next i
End With
End Sub
Mido
I need to find the value of the last cell in column b of sheet1. This value will change weekly. I then want to take that value and find it in sheet2. Then I want to copy and paste all data below this found value to sheet3. I can't get past the first part with the following code:
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Set cell = Range("B:B").Find("rangefound")
rangefound = lastRow = Cells(lastRow, 2).Value
I've been struggling with the syntax for a month and really don't know what I'm doing.
try this
Sub test()
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
Set cell = Sheet2.Range("B:B").Find(rangefound)
MsgBox "The value was found in Sheet2!" & cell.Address
End Sub
The issues with your code were
using rangefound before it had a value, i.e. the order of the commands
using "rangefound" as a text instead of the variable
wrong syntax to assign a value to rangefound
not qualifying which sheet should be searched
Edit: To extend the code to copy the data below the found value to another sheet, use Offset to reference one row below. There are many different ways to do this, so using Offset is just one option.
Here is the complete code
Sub test()
Dim mycell As Range, RangeToCopy As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
' this is the cell with the found value
Set mycell = Sheet2.Range("B:B").Find(rangefound)
' now find the last row in Sheet2. We can use lastRow again,
' since it is no longer needed elsewhere
lastRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row
' set the range to copy to start one cell below rangefound
' to the end of the data in column B
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' copy the range and paste into Sheet3, starting at A1
RangeToCopy.Copy Sheet3.Range("A1")
End Sub
Note: I changed the variable name from "cell" to "mycell". It's better to use variable names that cannot be mistaken for Excel artifacts.
Another edit: If you need to paste into the next free row in Sheet3, use the techniques already established.
[...]
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' get the next available row in Sheet3
lastRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1
' copy and paste
RangeToCopy.Copy Sheet3.Range("A" & lastRow)
[...]
Note that I'm using the same variable for three different purposes. If that is too confusing, create three distinct variables instead.
How can I cycle through sheet1 to see if there is data in that cell?
If there is no data then go to the next cell.
If there is data in the next cell paste it into sheet2.
The criteria are:
I cannot use a set range it will change as the data changes in sheet1.
I can keep sheet names a constant such as sheet1 and sheet2.
I found a way using columns and or rows yet that code has a major issue. If there is no starting data in the first cell it will not copy anything in the entire row and or column.
I am posting the code I worked with to check the data in columns but if there is no starting data it will skip the whole row.
Sub CopytoImport()
Dim wb As Workbook
Dim iCol As Long
Dim ws As Worksheet
Sheets("sheet2").Cells.ClearContents
' Loop through the column
For iCol = 1 To 22 ' Call out columns I cannot set this every time it should look threw all cells
With Worksheets("sheet1").Columns(iCol)
' Check tht column is not empty
If .Cells(1, 1).Value = "" Then
'Nothing in this column
'Do nothing
Else
' Copy the coumn to te destination
Range(.Cells(1, 1), .End(xlDown)).Copy _
Destination:=Worksheets("sheet2").Columns(iCol).Cells(1, 1)
End If
End With
Next iCol
ActiveWorkbook.Save
End Sub
Function runcode()
Call CopytoImport
End Function
Cells(1, 1) is just RANGE.("A1") you are only operating on this cell in your code. You would need Cells(1, iCol) to account for what column you are on during your loop.
You might also need a nested loop since you are looping through rows as well. The basic outline of a nested loop is as follows. Note the Cells(1,1) is replaced with the i and j representing what row and what column we are on. This might not be the fastest way to achieve the results you want but it sounds like this is what you are asking for help with. You will also need to define a lastrow (with a + 1 at the end to get the next blank cell) in your Sheet2 for when you paste the data. You would put this right under where the loop starts going through rows. This is so the lastrow of your sheet2 is recalculated each time data is being moved to that sheet. I am not going to re-write your code since you stated it is not complete but here is an example that should help you.
For j = 5 To lastcolumn
For i = 5 To lastrow
Dim lastrow2 As Long
lastrow2 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
If Worksheets(2).Cells(i, j).Value <> 0 Then
Worksheets(1).Range("C" & lastrow2).Value = Worksheets(2).Cells(i, j).Value
Worksheets(1).Range("B" & lastrow2).Value = Worksheets(2).Cells(2, j).Value
End If
Next i
Next j
To find your lastrow:
dim lastrow as long
lastrow = Range("A" & rows.count).End(xlup).Row ' or whatever column contains the data
To find your last column
Dim lastcolumn As Long
lastcolumn = Worksheets(2).Cells(2, Columns.Count).End(xlToLeft).Column
I would like to know in vba how to count the row until a particular text "Y" is reached.
For example
I want to capture the value of the row count and use it in the for loop
For example,
For x = x-1 to ctrow
Debug.print ctrow
In the above for loop the value of ctrow should dynamically change to next row count for "Y" value once it reaches the first "Y" value. There is a "Date" field associated with the "Sample data". Once the value "Y" is matched, the date value of the "Date' field will get copied to a different workbook against same "ID" value.
It seems complicated to me. Also i found out other solution but none is working.
Also, if I need to tweak the for loop kindly let me know as well. Thanks a lot.
Sub G()
Dim rng As Range, lr, rngCopy As Range
Set rng = Range("A1").CurrentRegion
rng.Sort key1:=rng(2), Order1:=xlDescending, Header:=xlYes
lr = Columns("B:B").Find("Y", SearchDirection:=xlPrevious).Row
Set rngCopy = Range("A1:B" & lr)
'//Copy results to new sheet
With Sheets.Add(After:=Sheets(Sheets.Count))
.Cells(1).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
End With
End Sub
The code below will accomplish your full task, you must change the worksheet names, columns, and Offset to meet your specific requirements(not enough information provided). The code will first_find a "Y" value in your "Flag" column in the first worksheet. Second_it will loop through each cell in the second worksheet and compare the "ID" in the first worksheet to find a match in the second worksheet. Third_If it finds a match then it uses Offset to select the cell where you want to paste the date from the first worksheet. Then continue looping until the end. If you have problems changing the worksheet, columns, or cells references, please ask.
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim lRow2 As Long
lRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
Set Rng1 = ws1.Range("B2", Cells(Rows.Count, Columns("A:A").Column).End(xlUp))
Dim cel As Range
For Each cel In Rng1
If cel.Value = "Y" Then
For j = 2 To lRow2
If cel.Offset(, -1).Value = ws2.Range("A" & j).Value Then
ws2.Range("A" & j).Offset(, 3).Value = cel.Offset(, 4).Value
End If
Next j
End If
Next cel