Copy/paste data into consolidated list - vba

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

Related

Weird activecell.offset output

Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.

Using a Macro to create a summary view of financials

I have 100 tabs which are financials of different facilities (all financial tabs are identical) and they list the revenue, expenses, etc down column A. I want to write a Macro or something that can take each tab and put that information horizontally into a summary tab so that my tab names will be going down column A with the revenue expenses, etc going across the top in row 1. I can write a simple macro that does 1 sheet at a time but I can't seem to get it to loop so it will continue doing the rest of the worksheets in the book. Does anyone know the code for this?
Thanks!
Jeff
You are going to need some variation on this concept: If you could provide the information requested in the comments of the OP, it could be more accurate. This example is assuming your summary info on each page is Row 2. If it isn't look for the line saying "assuming your data is row 2" and change the row from 2 to the actual row.
Also, you might have issues if you have other sheets in the Workbook that aren't to be included in the summary. If I knew how you named your sheets, I could help. You could test each of the sheets in the workbook for something, like if it is hidden or not. Or just check the name.. Do the first characters of ws.Name = something specific? You would need to un-Comment the IF statement and the End If, and include a real test for the IF at that stage.
As is, this will include EVERY Sheet, including the Summary Sheet that you are creating. It will involve you going through the Summary sheet and making sure only sheets you want got copied.
Sub SummaryBuilder()
Dim ws As Worksheet
Dim lastCol As Long
Dim lRow As Long
'Set your Summary Sheet up with Header Rows to match your Source Sheets
lastCol = Sheets("Summary").Cells(1, Columns.Count).End(xlToLeft).Column
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
'If ws passes test Then 'If Left(ws.Name, 4) = "2014" for example or If ws.Visible = True
Sheets("Summary").Cells(lRow, 1) = ws.Name 'Sets Column A with NAME of Sheet
For lCol = 2 To lastCol 'Loops through all summary columns
Sheets("Summary").Cells(lRow, lCol) = Sheets(ws).Cells(2, lCol) 'Assuming your data is Row 2
Next lCol
lRow = lRow + 1
'End If
Next ws
End Sub

VBA code in Excel to add a row to multiple sheets and then copy formula from adjacent row

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

Macro to copy data from one sheet to another, only if not already present

I am struggling with this macro. I have two sheets; One with a large set of data that is updated by a macro with respect to multiple dates.
I want to copy the data from that sheet ("rawdata1") to another sheet ("sheet1"), but only if the data isn't already present (don't want multiple entries of the same data on "sheet1"). I have no problem copying the data to the other sheet but how do you avoid duplicate entries when the macro is run multiple times?
The code I have so far:
Sub CopyData()
'Copy data if not present in other sheet
'???
Sheets("rawdata1").Select
Range("A4:AC10000").Select
Range("A4:AC10000").Copy
Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Paste
Sheets("Sheet1").Select
Thanks for the help!
Your code can be simplified to:
Sheets("rawdata1").Range("A4:AC10000").Copy _
Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1,0)
Sheets("Sheet1").Select
As for preventing multiple copies of the same line, if you're in Excel 2007+ then you can use RemoveDuplicates after running the copy: this will reduce the range down to unique rows only. Note: you need to adjust the Columns parameter to include all relevant column numbers.
ActiveSheet.UsedRange("$A$1:$E$8").RemoveDuplicates _
Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes 'or xlNo, depending on your data

Looking to select an undetermined number of rows in excel as part of larger VBA macro

I'm working with an excel book containing a large number of sheets; the first sheet is linked to an external program and pulls in data via an external function, and the number of lines imported varies significantly.
This block data is the disseminated over a number of subsequent sheets. The first step has been to populate column A (row name) with the number of rows in sheet 1. From here the data is split over a number of columns (currently B->L). The top row uses an IF() function to populate the first row, and I'm looking to write a clean macro to copy this formula to row x (which varies with each data import refresh) and then paste values for a manageable file size.
Here's what I've got so far; it works, but it's fairly (read: VERY!) clumsy:
Sub Refresh_Data()
Sheets("Sheet2").Select
ActiveWindow.ScrollWorkbookTabs Sheets:=13
Sheets(Array("Sheet2" ... "Sheet25")).Select
Sheets("Sheet2").Activate
Sheets("Sheet25").Select Replace:=False
Range("B1:L1").Select
Selection.Copy
Range("__B2:B1000__").Select
ActiveSheet.Paste
Application.Calculate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("Sheet2" ... "Sheet25")).Select
Sheets("Sheet2").Activate
Sheets("Sheet25").Select Replace:=False
Sheets("Sheet2").Select
Range("B3").Select
Sheets(Array("Sheet2" ... "Sheet25")).Select
Sheets("Sheet2").Activate
Sheets("Sheet25").Select Replace:=False
Range("B3:L4").Select
Range("__B2:L1000__").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Check_sheet").Select
MsgBox "Update complete"
End Sub`
The main thing I'm looking to achieve is to replace the code B2:L1000 with something that can assess the number of rows in column A and select a range in rows B to L accordingly.
Since column L is the last populated column, I don't see why this can't also be done horizontally rather than defining "B:L" incase future columns need to be added.
Although the earlier answer has merits:
1) I would not use COUNTA because if there are empty cells in the row or column, the cells at the bottom or the right will be ignored.
2) I would never rely on the user picking the correct sheet to be used before running a macro; particularly one with so many sheets.
My reaction to the question is that you have set Macro Record, wandered around your workbook and then stopped the record. You select one thing, then another. You scroll through the sheets. To me most of the statements are not clumsy they are pointless.
The following does include an answer to your question about finding the last row of column A but it is more a tutorial about finding the dimensions of a range, getting data out of the range and then putting it somewhere else. This seems to be most of what you are trying to do with the most minimal understanding of VBA. I am sorry if this criticism is unfair but that is the impression your question gives to me.
Sub Test()
Dim RowS01Max As Integer
Dim Sheet1Data() As Variant
' With Sheets("Sheet1") allows you to access data within worksheet Sheet1
' without selecting it.
' Range("A1:C11") refers to a range within the active sheet
' .Range("A1:C11") refers to a range within the sheet identified in the
' With statement.
' ^ Note the dot
With Sheets("Sheet1")
' Rows.Count is the number of rows for the version of Excel you are using.
' .Cells(Rows.Count, "A") address the bottom row of column A of worksheet
' Sheet1.
' .Cells(Rows.Count, 1) refer to column A by number.
' End(xlUp) is the VBA equivalent of Ctrl+Up.
' If you positioned the cursor at the bottom of column A and pressed
' Ctrl+Up, the cursor would jump to the last row in column A with a value.
' The following statement gets that row number without actually moving
' the cursor.
RowS01Max = .Cells(Rows.Count, "A").End(xlUp)
' The following statement loads the contents of range A1:C11 of
' Sheets("Sheet1") into array Sheet1Data.
Sheet1Data = .Range("A1:C11").Value
' This is the same statement but the range is specified in a different way.
' .Cells(Row,Column) identifies a single cell within the sheet specified in
' the With statement. .Cells(1,1) identifies row 1, column 1 which is A1.
'. Cells(11, "C") identifies row 11, column C which is C11.
Sheet1Data = .Range(.Cells(1, 1), .Cells(11, "C")).Value
' This statement uses RowS01Max to specify the last row
Sheet1Data = .Range(.Cells(1, 1), .Cells(RowS01Max, 1)).Value
' In all three examples above, the contents of the specified range will
' be loaded to array Sheet1Data. Whichever range you pick, Sheet1Data
' will always be a two dimensional array with the first dimension being
' the row and the second dimension being the column.
' In the first two examples Sheet1Data(5,3) contains the contents
' of cell C5. In the third example, I have only loaded column A but the
' array will still has two dimensions but the only permitted value for the
' second dimension is 1.
' The following statement writes the contents of Sheet1Data to column "E"
.Range(.Cells(1, 5), .Cells(RowS01Max, 5)).Value = Sheet1Data
End With
With Sheets("Sheet2")
' The following statement writes the contents of Sheet1Data to column "E"
' of worksheet Sheet2.
.Range(.Cells(1, 5), .Cells(RowS01Max, 5)).Value = Sheet1Data
End With
End Sub
Don't despair! Most of us started with the macro recorder and still use it to discover the syntax for an unfamiliar command. Look through other questions. Some ask about exotic functionality but many are about moving data around in, to the experienced programmer, simple ways. Set up some workbooks with the questioner's problem. Copy and paste the solution into a module. Step through it using F8 (see the debugger), switch between Excel and Editor, watch what is happening to the worksheet and move the cursor over a variable to see its current value. Spend half a day playing. You will be amazed at how quickly it starts to make sense. Good luck and good programming.
The following should do the trick:
Sub Refresh_Data()
Dim lastRow As Integer
Dim lastCol As Integer
Dim entireRange As Range
Dim targetRange As Range
lastRow = Excel.Evaluate("COUNTA(A:A)") ''// count the rows in column A
lastCol = Excel.Evaluate("COUNTA(1:1)") ''// count the columns in row 1
Set entireRange = Range(Cells(1, 2), Cells(lastRow, lastCol))
Set targetRange = Range(Cells(2, 2), Cells(lastRow, lastCol))
entireRange.FillDown
Application.Calculate
targetRange.Copy
targetRange.PasteSpecial Paste:=xlPasteValues
End Sub
Notes:
Excel.Evaluate(...) allows you to use the result of worksheet functions in your VBA macros.
COUNTA(range) is a worksheet function that counts the number of non-blank cells in a given range. In this case, it can be used to determine the total number of rows in your data set, as well as the number of columns in row 1 that have a formula in them.