I have a Data Validation list in cell T3 in Sheet3 of my workbook. The list contains location names. In sheet1 of my workbook I have all the data for all locations in tables next to each other, e.g
location 1|date|score|percentage|target| |location 2|date|score|percentage|target| etc....
I am looking to select a location from the drop down list and that will copy in the relevant table to sheet3. So you just select a location and can see the data. I'm wondering if the best way to go about this is formulas or to use VBA (my experience with using drop down lists in VBA is limited). Here is something that I am currently working on but it is incomplete at the moment and still leads to the question of 'is there a faster way to do this in VBA'. Any help or advice is greatly appreciated! (my validation list is called List1)
=IF(ISNUMBER(A2),IF(ISERROR(VLOOKUP(A2,Sheet1!$A:$EG,MATCH(List1,Sheet1!$1:$1,0),FALSE)),0),"")
The idea is that i could have a table of formulas so depending on the list value, different data would appear.
This isn't complete but it should get you started / give you some ideas
Sub CopyTable()
Dim colNo, lastRow As Integer
Dim ws1, ws3 As Worksheet
Set ws1 = Sheets("Sheet1") ' assign the worksheet variables
Set ws3 = Sheets("Sheet3")
colNo = Application.Match(ws1.Range("T1"), ws1.Range("A1:R1")) ' work out which column the required table starts in
lastRow = ws1.Cells(10000, colNo).End(xlUp).Row ' work out the last row of the table
ws1.Range(ws1.Cells(1, colNo), ws1.Cells(lastRow, colNo + 4)).Copy ws3.Range("A1") ' copy the table
End Sub
Related
I have an Excel sheet that has a table in range A4:BD4 (this is the first row of the data. I want to clear the data but leave the table intact. I do not know how many rows are of data are in the table, it will vary.
The table itself has a few more columns but I do not want to remove the data from them just from A thru BD. BE for instance needs to hold the data.
Here is code that removes all the data from all the columns:
For Each mySheet In wb.Sheets
For Each myTable In mySheet.ListObjects
myTable.DataBodyRange.ClearContents
Next myTable
Next mySheet
Thanks for any help with this.
This should work; you can use offset and resize together to skip over whichever areas you want to leave intact:
Sub ResetTables()
Dim wb As Workbook
Dim mySheet As Worksheet
Dim tbl As ListObject
Set wb = ThisWorkbook
For Each mySheet In wb.Sheets
For Each tbl In mySheet.ListObjects
With tbl.DataBodyRange.Offset(0, 0)
.Resize(.Rows.Count, .Columns.Count - 1).Columns.ClearContents
End With
Next tbl
Next mySheet
End Sub
I think you may find this resource helpful if you want additional help:
http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
I want to copy data from one table to another, from one workbook to another.
I know the table names, they are identical.
The source table has an unknown number of data rows plus an unknown number of empty rows. The destination table (same name, same sheet) has only empty rows, but not necessarily the same overall number of rows as the origin.
i know i can do something like
sourceBook.Activate
ActiveSheet.ListObjects(knownTableName).DataBodyRange.Select
Selection.Copy
destinationBook.Activate
ActiveSheet.ListObjects(knownTableName).DataBodyRange.Select
ActiveSheet.Paste
However there are a number of problems:
The table is not on the activeSheet. How do i find the sheet that the table is on? or is there a better way to reference it (ideally without having to find the sheet first)?
I know .Activate and Selection.Copy is slow and bad. How can i do it better?
How do i find the "used" data range of both tables without looping through the table rows?
Is it possible to copy the data row by row (so that only non empty rows are copied)? ideally, i would like to just insert all non-empty source rows to the destination table and subsequently delete all empty rows in the destination table
To answer question 2:
Dim loSource as ListObject
Dim loDestination as ListObject
Set loSource = ... 'To do
Set loDestination = ... 'To do
loDestination.Range(2,1).Resize(loSource.ListRows.Count, loSource.ListColumns.Count).Value = loSource.DataBodyRange.Value
Answer to your first problem (maybe you could break your question up and ask different questions for different problems)
Since ListObjects is a child of WorkSheet -- I don't see of any way to avoid iterating through the workbooks looking for the sheet containing the table. Something like this:
Function FindTable(WB As Workbook, TableName As String) As String
Dim ws As Worksheet
Dim wsName As String
On Error Resume Next
For Each ws In WB.Sheets
wsName = ws.ListObjects(TableName).Parent.Name
Next
If Len(wsName) = 0 Then
FindTable = "Table Not Found"
Else
FindTable = wsName
End If
End Function
To test it I created a table named "Hidden Table" and put it on sheet 3. Then I ran this:
Sub test()
Debug.Print FindTable(ActiveWorkbook, "Hidden Table")
Debug.Print FindTable(ActiveWorkbook, "Nonexistant Table")
End Sub
Which printed:
Sheet3
Table Not Found
I want to make drop Down List in sheet2 which contains values from sheet1 column. I have tried this code.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
columns in sheet1 are changing oftenly. so needs to create Dynamic VBA Macro code.
Please guide me for this query.
For your case, I don't think that you need a macro to manage the drop down list but perhaps data validation will do.
Create a new worksheet,
I got a worksheet contain the following data at column A
At the worksheet that i want the dropdownlist, i just highlight the cell and click on the data validation button at data ribbon
In the data validation, create the following setting
Click on the ok button and the list will be created
Since in the columns in the worksheet(source) keep on changing, you need write the macro to copy the entire needed column exclude the header of the column to next worksheet(e.g. worksheet that create the dropdown list).
Edited: Code to detect the criteria column and copy the column
Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyWorksheet2 As Worksheet
Dim WantedColumn As Long
Dim ColumnPointer As Long
Sub copyCriteria()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Sheet6")
Set MyWorksheet2 = MyWorkbook.Sheets("Sheet5")
For ColumnPointer = 1 To MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
If MyWorksheet.Cells(1, ColumnPointer).Value = "ColumnE" Then
MyWorksheet.Columns(ColumnPointer).Copy
MyWorksheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
MyWorksheet2.Rows("1:1").Delete Shift:=xlUp
End If
Next
End Sub
What you are trying to do can be done with a simple named range and Data Validation to use that Name. If you have not heard of Dynamic Ranges, then you should read on.
If Sheet1 only has the 1 column for the DropDown list via Data Validation, you should use a Named Range instead of a fixed Range. But this named range is dynamic (by using formula)! See OFFSET usage.
Lets say Sheet1 is like below:
Lets say the name to be used is MyList, then in Excel click Name Manager in Formulas tab, and place in below as the Range Refers to:
=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A))
Now in Sheet2, the Data Validation is placed on B2, when setting it up, once you put in the source to =MyList, Excel highlights it:
Then the drop down list worked:
Now if you add data to your list (Column A on Sheet 1), the MyList automatically expands and hence your DataValidation drop down list!
Note the list will go up to the first blank cell in Column A, so NO GAPS!
Enjoy!
I am enclosing a link with a sample spreadsheet.
What I would like to do is create multiple worksheets using the key column of "Facility", perhaps using a macro. For example, I would like to create a new worksheet called Houston and fill the worksheet with the data specific to that row. Some of the cells may end up in different locations in the new worksheet. I need to do a separate worksheet for every value in "Facility". The original that I am working on has 270 rows (270 facilities).
Does anyone have any idea how to do something like this? I am new to running and creating macros. I did create a macro that didn't work right.
Try this:
Dim wks As Worksheet
Dim lstRow As ListRow
For Each lstRow In ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").ListRows
Set wks = ThisWorkbook.Worksheets.Add
wks.Name = lstRow.Range.Cells(, 1).Value
With wks
.Range(.Cells(1, 1), .Cells(1, lstRow.Range.Columns.Count)) = lstRow.Range.Value
End With
Next
Set wks = Nothing
Assumptions:
Worksheet name where data resides is called Sheet1
Table containing data is a ListObject (e.g., convert your data range into an Excel table)
ListObject name is Table1
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.