I am new to VBA and I'm trying to write a Macro in Excel that copies a table to another table and then deletes lines where a cell is equal to the value "0".
I have a table as follows:
I want the table to look like this:
Can anyone help me?
The following will copy data from a table in Sheet1 to Sheet2 where the second column is not 0 - using the table's Autofilter.
I had to add a 1 second application.wait to allow the filter to be applied before copying. This might need increasing depending on table size. Perhaps someone else could help with a more robust method of waiting for the filter to apply..?
Dim source_sheet As Worksheet
Dim destination_sheet As Worksheet
Set source_sheet = Sheets("Sheet1")
Set destination_sheet = Sheets("Sheet2")
With source_sheet.ListObjects("Table1").Range
.AutoFilter Field:=2, Criteria1:="<>0"
Application.Wait 1
.Copy Destination:=destination_sheet.Range("A1")
.AutoFilter Field:=2
End With
It's worth mentioning that the output to Sheet2 is not in a true table form. However, it shouldn't be tricky to record a macro where you convert it to a table to gain that piece of code too.
Related
I have 2 different workbooks, main and copy.
Row 1 is meant for header/labeling the information it will be providing for both workbooks.
The "main" workbook will be using columns A to N. The copy will be using columns A to M.
The criteria to determine whether the code will be copying is the workbook, "main", column M.
If the cell contains "X" - it will copy column A to L, and N, to the workbook "copy". After which, it will go on to the next row to determine the same thing.
If the cell is empty, it will proceed down to the next row to determine the same thing as well.
The code has to be dynamic as new information will be added every 3 months, such as new rows added or the criteria changing from "X" to empty, or empty to "X".
I am a beginner in VBA excel, and have been trying out multiple codes but it doesn't seems to work. Would greatly appreciate it if someone could help me out with this.
Showing your code so far will help us a lot.
Maybe this helps a little:
Dim wks As Worksheet
Dim wks_copy As Worksheet
Set wks = Worksheets("main")
Set wks_copy = Worksheets("copy")
j = 2
For i = 2 To wks.UsedRange.Rows.Count
If wks.Cells(i, 13).Value = "x" Then
wks.Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=wks_copy.Cells(j, 1)
j = j + 1
End If
Next i
This will copy the entire row. If you don't want to copy column M, I suggest clearing or hiding the column after copying.
If the macro runs again after 3 months, it will overwrite the existing data on Worksheet copy. But you should delete the worksheet's values before that, for example by using
Worksheets("copy").UsedRange.Offset(1, 0).ClearContents
or manually clearing the range.
New to VBA, and I'm trying to create multiple ranges or arrays based on a criteria in a column, then place those in a separate worksheet. The issue is that this code has to work for several different data sets. So one data sat will look something like
this, but with far more data points ( around 10,000 for each data set).
So what I'm trying to do is, for each group of 1's in the state column, create a range/array, then move the corresponding time and data in a new worksheet. So for the example I have, there would be 3 new worksheets, with the first new worksheet containing range("A2:B5"), the second one containing range("A10:B12"). With each data set, the state column changes and the number of new worksheets can also vary.
I have looked through this site, and the closest I have found to my needs is Creating Dynamic Range based on cell value, but it has a known number of ranges. I quite honestly have no idea how to accomplish what I need. I've been trying to make a while loop inside of a if then loop inside of a for each loop, but can't make it work.
Any help would be greatly appreciated! Been banging my head for hours now.
this should help you:
Option Explicit
Sub main()
Dim area As Range
With Sheets("myDataSheet") '<--| reference your sheet (change "myDataSheet") to your actual sheet name
With .Range("C1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:C range form row 1 down to last column A not empty row
.AutoFilter Field:=3, Criteria1:="1" '<--| filter referenced range on its 3rd column (i.e. "State") with 1
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header
For Each area In .Resize(.Rows.Count - 1, 2).Offset(1).SpecialCells(xlCellTypeVisible).Areas '<--| loop through filtered range (skipping header) 'Areas'
area.Copy Sheets.Add(Sheets(Sheets.Count)).Range("A1") '<--| copy current 'Area' into new sheet
Next area
End If
End With
.AutoFilterMode = False
End With
End Sub
I'm stuck on how to structure a piece of code that:
Loops through all worksheets that begin with the number 673: (e.g. 673:green, 673:blue)
Selects the data in these worksheets from row 5 up until the last row with data - code that works for this (generously provided by another user) is
Dim report As Worksheet
Set report = Excel.ActiveSheet
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End(xlUp)).EntireRow.Select
End With
Select the "Colours" worksheet
Paste the rows at the next available blank row. There could be up to 40/50 worksheets which will have data pasted into the "Colours" worksheet so I need the data added to the next available line.
Thank you in advance.
Loop over the sheets in the workbook and check their names
For Each sheet in ActiveWorkbook.Worksheets
If Instr(sheet.Name,"673")>0 Then
...
End If
Next
Good, but you're going to want to copy.
Selection.Copy
Just select.
Worksheets("Colours").Select
Find the last row then go to the next. The row is found by finding the first populated row from the bottom up. Note I used explicit sheet references, which is unnecessary since you selected the sheet already. This is better form, however, if you will be manipulating data on multiple sheets in your code.
lastRow = Worksheets("Colours").Cells(Worksheets("Colours").rows.count,1).End(xlUp).Row
Worksheets("Colours").Cells(lastRow + 1, 1).Select
Activesheet.Paste
I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub
Ok, the question sounds pretty vague, but i will try to explain.
I am trying to copy certain cell values from one sheet into another sheet. The place it should copy it to, is determined by another value in the same sheet. For example:
Sheet1
4040-5056 ----- 4040-5056v1.7
3409-5793 ----- 3409-5793v4.3
Sheet2
4040-5056
3409-5793
Based on the first values you see, the second column of values in sheet1 should be copied in the corresponding cells in sheet2.
I have no idea how to do this, any help would be appreciated!
Thanks in advance
EDIT:
Sheet1 contains all values that have to be copied to the corresponding nvalues in the other sheets.
The values it has to correspond with are spread over 30 sheets or so, but all in the same document. In every sheet the values the code has to look for are all in the same column, so in every sheet is should look whether the value is the same in column A. VLOOKUP works, but is still a slow option, knowing that is handles over 36.000 rows. What the code should do, is copy the value of column B to one of the other sheets, if the value of column A corresponds with the value of column A in the other sheet.
I hope everyone can understand this explanation.
You can use the VLOOKUP function. No need to use VBA for this.
Sheet 1 :
A B C
1 4040-5056 4040-5056v1.7
2 3409-5793 3409-5793V4.3
3
Sheet 2:
A B C
1 4040-5056 =VLOOKUP(A1;Sheet1!$A$1:$B$2;2;FALSE)
2 3409-5793 =VLOOKUP(A2;Sheet1!$A$1:$B$2;2;FALSE)
3
Cell B1 will display "4040-5056v1.7", cell B2 "3409-5793V4.3"
Note that the last argument to VLOOKUP (here FALSE) is important in your case since the data is unsorted.
Another solution, using pure VBA:
Since there is a strong need for performance, I suggest using a dict object, as hinted in this SO question. The advantage of using a dictionary is that it is very fast to lookup, once it is built. So I expect my code to be very quick in the lookup. On the other hand, it will be slower in accessing the individual cells (through loops) than the builtin VLOOKUP.
Comparative performance, using a reference sheet fof 30'000 entries, and 3 lookup sheets with 30'000 lines each:
VLOOKUP : 600 seconds
VBA / dictionary : 3 seconds
so the performance is 200x better with VBA dictionary in this context.
Note : you have to add a reference to "Microsoft Scripting Runtime" (from the tools->Reference menu of the VBA window)
Note : this solution will not work if the data in the reference sheet is not contiguous, or if there are duplicates.
Sub FillReferences()
Dim dict As New Scripting.Dictionary
Dim myRow As Range
Dim mySheet As Worksheet
Const RefSheetName As String = "sheet1"
' 1. Build a dictionnary
Set mySheet = Worksheets(RefSheetName)
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Append A : B to dictionnary
dict.Add myRow.Value, myRow.Offset(0, 1).Value
Next myRow
' 2. Use it over all sheets
For Each mySheet In Worksheets
If mySheet.Name <> RefSheetName Then
' Check all cells in col A
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Value exists in ref sheet ?
If dict.exists(myRow.Value) Then
' Put value in col B
myRow.Offset(0, 1).Value = dict(myRow.Value)
End If
Next myRow
End If
Next mySheet
End Sub