I have four rows of information that I filter. (month, Name, Service, units) I filter the information by name and month. (depending on information needed) I have put together the following to try and grab the top row of filtered data and place it on another sheet.
Sub Mine()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lRow As Long
Set sht1 = ThisWorkbook.Sheets("Export")
Set sht2 = ThisWorkbook.Sheets("DB1")
lRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row + 1
sht1.Range("b" & lRow) = sht2.Range("A2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Month
sht1.Range("a" & lRow) = sht2.Range("E2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Client Name
sht1.Range("c" & lRow) = sht2.Range("C2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Service
sht1.Range("d" & lRow) = sht2.Range("H1" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Units
End Sub
This does not error out, it just doesn't copy anything to the "export" sheet. The only way I can get anything to copy from one sheet to another is to take the specialcells out. As follows...
Sub Mine()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lRow As Long
Set sht1 = ThisWorkbook.Sheets("Export")
Set sht2 = ThisWorkbook.Sheets("DB1")
lRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row + 1
sht1.Range("b" & lRow) = sht2.Range("A2") 'Month
sht1.Range("a" & lRow) = sht2.Range("E2") 'Client Name
sht1.Range("c" & lRow) = sht2.Range("C2") 'Service
sht1.Range("d" & lRow) = sht2.Range("H1") 'Units
End Sub
But as said prior, it only copies the first line, filtered or not. My goal is to obtain the filtered top line of "DB1" and copy it to sequenced cells in "Export". Any assistance would be greatly appreciated.
-JGr3g
Okay, so I don't think your code is doing what you think it is.
Lets take some apart
sht2.Range("A2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
You're calling sht2.Range() and passing it a string. That string is the concatenation of "A2" and Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible).
What is Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)? Well implicitely Cells is a range representing every cell in the active spreadsheet, ThisWorkbook.ActiveSheet.Cells. Then you're asking for SpecialCells(xlCellTypeLastCell) and taking it's row? What happened to sht1 and sht2? You aren't using them, you're using the active sheet?
So if the last cell of the active sheet is in row 50, you are asking for "A2" & 50 which would get "A250", which would be blank since the last used row is 50...
First things first, I'd recommend you avoid using string concatenation for finding cells. None of this "A" & numericVariable stuff. Use something more direct like Cells(numericVariable, 1). Excessive string manipulation will likely hurt you. The cells property can take a row and a column as parameters.
Is your filered range a table/listobject or just a plain old range with an AutoFilter on it? If it's a listobject, get the listobject, get it's DataBodyRange, use .SpecialCells(xlCellTypeVisible) on that, THEN get the first row of the resulting range.
Similarly if it's an autofiltered range, get the target data range, the entire data range. Once you have that, grab the visible cells, then get the first row.
Edit: Untested example
set targetRow = ws.Range(ws.Cells(2, 1), ws.Cells(lRow, 5)).SpecialCells(xlCellTypeVisible).Row(1)
targetSheet.Range("A2") = targetRow.Cells(1,2)
Okay, so what's this doing? I'm taking a worksheet variable ws and getting a range on it. .Range(ws.Cells(2, 1), ws.Cells(lRow, 5)). That range, is from the second row, first column, aka "A2". It goes to the row number contained in lRow on the 5th column, aka "E" & lRow.
From there it gets only the visible cells .SpecialCells(xlCellTypeVisible) then gets the first row of the first area in the selection .Row(1)
Once we have that first row, we can get different columns from it with either .Cells or .Column.
Related
I'm using the following code to find the last row in Sheet1 & Sheet2
Dim 1LastRow As Long
Dim 2LastRow As Long
1LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
2LastRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
This works as initially expected, however I'd like "1LastRow" to adjust to dynamically pick up the last row.
For example, if Sheet1 initially has 50 rows, but after:
Sheets("Sheet2").Range("B2:B" & 2LastRow).Copy
Sheets("Sheet1").Range("D2").PasteSpecial xlPasteValues
Sheet1 now has 55 rows. However, "1LastRow" is still assuming that Sheet1 only has 50 rows, and thus creates inconsistencies throughout the rest of the code when "1LastRow" is used. Any input is greatly appreciated!
Well, a variable doesn't magically update itself. You see that you have code that pastes rows. Just repeat the code that sets the variable for the last row when you do something that changes the last row.
Dim 1LastRow As Long
Dim 2LastRow As Long
1LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
2LastRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Range("B2:B" & 2LastRow).Copy
Sheets("Sheet1").Range("D2").PasteSpecial xlPasteValues
1LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Or you could use a dynamic range name with a formula along the lines of
=INDEX(Sheet1!$A:$A,COUNTA(Sheet1!$A:$A))
Then refer to that range like
ThisWorkbook.Worksheets("Sheet1").Range("OneLastRow").Row
But this will fall over if the column contains blank cells.
first off your code won't compile in an Office VBA environment: variables names can't start with a number. So let's call them LastRow1 and LastRow2, instead
second, even if there were some automagic way of making a variable self update, your code would fail since you are copying a 1-column range from Sheet2 and pasting it starting from cell D2 of Sheet1, which would have no effect whatsoever in column A last row index setting
all that said, you have could use a Function() that returns the wanted row index.
For instance this function:
Function LastRow1() As Long
With Sheets("Sheet1")
LastRow1 = .Cells(.Rows.Count, 4).End(xlUp).Row
End With
End Function
would return Sheet1 column D last not empty row index (well, it would actually fail should column A be totally empty, but it's an easy fix)
you could easily have it return any other column last not empty cell row index by simply changing column index in .Cells(.Rows.Count, 4)
so that your "main" code would look like:
Sub main()
Dim LastRow2 As Long
LastRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Range("B2:B" & LastRow2).Copy
Sheets("Sheet1").Range("D2").PasteSpecial xlPasteValues
MsgBox LastRow1 ' this would return Sheet1 column D last not empty row index
MsgBox Sheets("Sheet1").Range("D2:D" & LastRow1).Address 'this would return the address of Sheet1 column D range from cell D2 down to last not empty cell
End Sub
I have a pivot table as in Image. I would like to copy and paste the rolling last 3 months values to another sheet. That is i need to copy NOV,DEC,JAN values to another sheet.That is Cell value A17:C17, A18:C18 and A7:C7.
For next month it must automatically copy DEC,JAN,FEB values. I used the below but i cant get the logic. I need to copy twice. First for Cells A,B,C and for cell A,D,E. How to change the code Help me
Sub Data()
Dim sws, dws As Worksheet
Dim lr1 As Long
Dim rng1 As Range
Set sws = Sheets("AVG")
Set dws = Sheets("Data")
lr1 = sws.Cells(Rows.Count, "B").End(xlUp).Row
Set rng1 = Union(sws.Range("E" & lr1).Offset(-2, -4).Resize(3), sws.Range("E" & lr1).Offset(-2, -1).Resize(3), sws.Range("E" & lr1).Offset(-2).Resize(3))
rng1.Copy dws.Range("A28")
Sheets("AVG").Range("A" & Rows.Count).End(xlUp).Offset(-2, -2).Resize(3, 3).Copy Sheets("Data").Range("A33")
End Sub
I have sheet 1 with Column name: Main task
MainTask
And, I have Sheet 2 where the Sub-tasks are given based on the characters between 1st and 2nd hyphen(-) of the Data in Main Task for eg: Under the main task column there is "Pyramid - IoT Forecast - Latin America - Argentina - 2017". So, based on the string " IoT Forecast" the sub tasks are given as in the below image.
Out Put:
Now In sheet 3 I need every title from the main task should be copied and pasted from the Sheet 1 and look for relevant sub tasks and pasted in the next column like the below image.
I have used, Wild cards, partial V-look up with Mid Function but only single sub task is populating. Please help me provide code in VBA.
Your Sheet 3 is identical to Sheet 2 but with the full main task in it instead of just the extract. I suggest the following method.
Create a column in Sheet 1 in which you write only the extract. This column would be identical in contents to column A of sheet 2. Use this formula to populate that column (where A2 contains the full main task).
=TRIM(LEFT(MID($A2,FIND("-",$A2)+1,100),FIND("-",MID($A2,FIND("-",$A2)+1,100))-1))
Make a copy of Sheet 2 as Sheet 3 and add a blank column B in it. Populate this column with this formula (where A:A is the column containing the full task, and C:C the column you added in step 1.
=INDEX('Sheet 1'!A:A,MATCH(A2,'Sheet 1'!C:C,0))
Replace the formulas in Sheet 3 with values (Copy / Paste values) and Remove column A from that sheet. Sort this sheet on what is now column A.
Remove the column you added in Sheet 1 to restore Sheet 1 to its original state.
You will need to do an array formula, something similar to the below where the sub category is in C1
=INDEX($A$2:$A$6,SMALL(IF(NOT(ISERROR(SEARCH("-" & $C$1 & "-",$A$2:$A$6))),ROW($A$2:$A$6)-1),ROWS($D$1:D1)))
If you are open to a VBA solution, you may try something like this.
The following code assumes that there are three sheets in the workbook named as "Sheet1", "Sheet2" and "Sheet3".
If the sheet names are different in your original workbook, please change them in the code in following lines before testing the code.
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Place the following code on a Standard Module and run the code to get the desired output on Sheet3.
Sub LookupData()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rng As Range, cell As Range, MainTask As Range
Dim lr2 As Long, lr3 As Long
Dim MainTaskStr As String, wht As String
Application.ScreenUpdating = False
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Range("A2:A" & lr2)
ws3.Cells.Clear
ws3.Range("A1:B1").Value = Array("Main Task", "Sub-Task")
If ws2.FilterMode Then ws2.ShowAllData
For Each cell In rng
If cell.Value <> MainTaskStr Then
MainTaskStr = cell.Value
lr3 = ws3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
wht = "- " & cell.Value & " -"
Set MainTask = ws1.Range("A:A").Find(what:=wht, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not MainTask Is Nothing Then
With ws2.Rows(1)
.AutoFilter field:=1, Criteria1:=MainTaskStr
ws3.Range("A" & lr3) = MainTask.Value
ws2.Range("B2:B" & lr2).SpecialCells(xlCellTypeVisible).Copy ws3.Range("B" & lr3)
End With
End If
End If
Next cell
If ws2.FilterMode Then ws2.AutoFilterMode = False
ws3.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
I would like to copy entire row from today Sheet to last available row of main Sheet if today Sheet B2:B cell value = "Update". However, I come up with copy area and paste area are not the same size issue. I've tried many ways but cannot get it solved. Can anyone help? Thanks in advanced.
Sub getnew()
Dim Sheet1 As Worksheet
Dim Sheet3 As Worksheet
Dim lastrow As Integer
Dim i As Integer
Set Sheet1 = ThisWorkbook.Sheets("main")
Set Sheet3 = ThisWorkbook.Sheets("today")
lastrow = Sheet3.Range("C" & Rows.Count).End(xlUp).Row
Dim erow As Long
For i = 2 To lastrow
erow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row + 1
If Sheet3.Cells(i, 2).Value = "Update" Then
Sheet3.Cells(i, 2).EntireRow.Copy Destination:=Sheet1.Range("B" & erow)
End If
Next i
End Sub
You are trying to copy the entire row of a worksheet, but you are pasting that row in another sheet, starting at column B. They aren't the same size, because an entire row contains 16,384 columns, but a row starting at column B only has 16,383 columns.
You have a few options to resolve this:
You could paste the entire row onto the other sheet at column A, like so:
Sheet3.Cells(i, 2).EntireRow.Copy Destination:=Sheet1.Range("A" & erow)
Or you could copy only the number of columns which you care about, instead of trying to copy the entire row, like so [I don't know what it is you're trying to copy, so you will need to figure out how exactly you want to size it. I have assumed that 10 columns is sufficient]:
Sheet3.Range(Cells(i, 2), Cells(i,11)).Copy Destination:=Sheet1.Range("B" & erow)
I would like to copy a range from a filtered table to another sheet. The starting point is easy however I would like to only copy a number of rows down based on a cell that a user enters into. I can make it work when I hard code the number however I would like to make this based on a cell.
The variable lastrow is where I need to have the cell H4. (H4 in my spreadsheet is where the user keys in the number of rows to copy)
My code thus far is:
Sub Line()
Dim Copyrange As String
Dim lastrow As Range
Startrow = 8
lastrow = 10
Let Copyrange = "B" & Startrow & ":" & "H" & lastrow
Range(Copyrange).Select
End Sub
Any help is really appreciated
Sounds like all you need is this?
Let Copyrange = "B" & Startrow & ":" & "H" & Range("H4")
Changing my answer to the following instead. Not the best of solutions, as working with SpecialCells is tricky at best, but this might suit your needs fairly well.
Sub Illusion()
Dim Source, Dummy As Worksheet
Dim SRow, LRow As Long
Application.ScreenUpdating = False
With ThisWorkbook
Set Source = .ActiveSheet
Set Dummy = .Sheets.Add(After:=Sheets(Sheets.Count))
End With
SRow = 8
LRow = Range("H4").Value + 1
'Change the H10000 below to the correct end row of your unfiltered table.
Source.Range("B" & SRow & ":H10000").SpecialCells(xlCellTypeVisible).Copy
With Dummy
'We create an illusion that we copy only the names we need by bridging using a dummy sheet and copying from there.
.Range("A1").PasteSpecial xlPasteValues
.Range("A1:A" & LRow).Copy
'Paste to desired location as values as well.
.Delete
End With
Application.ScreenUpdating = True
End Sub
What I did here was, we copy the visible cells into a dummy sheet, adjust the number of names to copy from that dummy sheet and do whatever you want with it, then delete the dummy sheet. It's a quick and dirty, but it beats having to go to the intricacies of SpecialCells.