Excel 2013: Use macro to copy and subsequently add data from one sheet to another within same workbook - vba

I have used the various methods pointed out in this forum and none seem to work, so I will try to be more specific.
I have a workbook called LIBRARY.xlsm.
This workbook contains two worksheets: CALCULATOR and CUTS.
The worksheet CALCULATOR contains two tables: INPUT and OUTPUT.
I enter data into INPUT, values are calculated and automatically entered into OUTPUT.
I create a button below OUTPUT with macro to copy data in OUTPUT to worksheet CUTS.
I enter new data into INPUT, which then updates OUTPUT.
Now I want to copy this new data to CUTS without overwriting or deleting previous data.
Since this project is divided into 5 sections, I should end up with five tables in the worksheet CUTS that I can then print out.
The INPUT table encompasses cells A1:M31, which does not matter (I’m not copying this).
The OUTPUT table occupies cells O6:S26. This is the data that needs to be copied.
Placement into worksheet CUTS can start at cell A1 (which means the table will have the range A1:E20). I would like to skip a column and then place the next data set. Thus, the next data set should begin at G1 (G1:K20), then at M1:Q20 and so forth). Maybe only go three tables across and then start next three below (separated by row).
Here is the code tried to use. Problem is, it does not retain the values and it overwrites the previous data.
Sub Create_CUTS ()
Dim sourceSheet As Worksheet
Dim sourceRange As Range
Dim sourceRows As Integer
Set sourceSheet = Worksheets("CALCULATOR")
sourceRows = WorksheetFunction.CountA(sourceSheet.Range("A:A"))
Set sourceRange = sourceSheet.Range("O6:S26" & sourceRows)
Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetRows As Integer
Set targetSheet = Worksheets("CUTS")
targetRows = WorksheetFunction.CountA(targetSheet.Range("A:A"))
Set targetRange = targetSheet.Range("A" & targetRows + 1 & ":A" & targetRows + 1 + sourceRows)
sourceRange.Copy Destination:=targetRange
End Sub
Thank you, everyone
-Grumps

There are a few ways to do this. The easiest is probably to just reference the usedrange of the target sheet to know where you left off with the last paste.
lastUsedRow = targetSheet.UsedRange.Rows.Count
lastColumnUsed = targetSheet.UsedRange.Columns.Count
Then you just add a column or row and paste the table in the new location. If the column count is 22 or greater, add a row and paste at "A" and the lastUsedRow + 2. There is some potential for this to be wrong if the sheets are saved with cells that are empty, but excel reads them as "used" (somehow people I work with manage to do this all the time, I don't even know how they do it). It sounds like this is something that users won't be manipulating, so I wouldn't think that would be a problem, but if it is a possible problem for you, you can use a loop to find the next empty cell instead of using the built in "usedrange" collection.

Related

Excel VBA Get Count of Non-Empty Rows in Range

I know this has been asked at least a dozen times, but of all those questions the solutions seemed to be tailored or simply created an error in my code. For some reason I get an error when I try and reference a range from a different worksheet. Below is my code. I have two worksheets (tabs). One has a button to launch my code MENU, the other is the data I am trying to read and write to RAW. All I am trying to do is find out how many rows of data the sheet has so I can loop through the rows and make changes. For some reason I can't wrap my head around it or something.
Private Sub CommandButton21_Click()
Dim wbCurrent As Workbook
Dim wsCurrent As Worksheet
Set wbCurrent = ThisWorkbook
Set wsCurrent = wbCurrent.Worksheets("RAW")
Dim i As Long
Dim siteCol As Long
siteCol = Range("I" & Rows.Count).End(xlUp).Row
For i = 1 To siteCol
wsCurrent.Range("I" & i) = "MARKED"
Next i
Range("I1") = siteCol
End Sub
1- Always use Long for your variables, not Integer unless you have a specific reason. The maximum value of an Integer is 32767, which might be not enough to hold your count of rows.
2- Dont get the number of rows with COUNTA, this has many drawbacks. use this instead:
siteCol = wsCurrent.Range("I" & wsCurrent.Rows.count).End(xlUp).Row
This finds the Row number of the last occupied cell in wsCurrent, assuming that wsCurrent is at the top of the document (it starts on Row 1). Please note that if wsCurrent is completely empty, this will find the row number of the first occupied cell above wsCurrent, or the first row of the document.
3- When you want to assign a whole range to the same value, you can do it at once, which is much faster and simpler, like this (no loop needed):
wsCurrent.Range("I1:I" & siteCol) = "MARKED"
4- No need to Activate a worksheet to work with it. Drop the statement wsCurrent.Activate and try to always work with qualified ranges.

Create a range using named cells

I need to create a range using named cells in vba.
So far I have the following which is not working;
Dim pasteRange As Range
Set pasteRange = Range(firstRow, 11)
pasteRange.Value(11) = slabTemplateSheet.Range("slabTemp").Value(11)
Where firstRow is an Integer. slabTemplateSheet refers to a worksheet and slabTemp is a named range in said sheet.
I thought it would be fairly simple as my paste range is only 1 row and 11 columns (i.e 11 cells in a row) but I can't get it to work.
In your answer, presuming there is one, could you also please give me the ability to paste multiple rows and columns, so for instance if slabTemp refers to A1:F16
Edit: I didn't make it clear what I am trying to do.
I have a named range called slabTemp in the worksheet slabTemplateSheet. In another sheet I want to copy that range, including the formatting, and paste it. I heard that using the copy/paste function was slow so I found the property above that supposedly does the same thing but is faster (i haven't tested it). Source, Durgesh's answer here: fast way to copy formatting in excel
In the new sheet I need to paste it into a range which is to be created (this is what i don't know how to do)
So Range(firstRow, 11) refers to the integer saved as firstRow (a row number) and 11 is the column number. But this doesn't work.
I guess my question, is how do i create a range using names rather than say Range("A1:G6") so instead Range(firstRow1:secondRow:6)
Thanks Again!
Here's a working example.
Public Sub CopyRange()
'Define the Copy Range
Dim CopyRange As Range: Set CopyRange = Range("MyCustomRange")
'Define the range to Paste Value to
Dim PasteRange As Range: Set PasteRange = Range("MyOtherCustomRange")
'Move the Copy Range into the Paste Range
'You don't need to specify the sheet name, the Defined named holds that information
'Important: The ranges should be the same size, otherwise you may get an error
PasteRange.Value() = CopyRange.Value()
End Sub
About how to create a Named Range (worksheet scope, not for Workbook per your code), use the code below. Not sure what are you trying to achieve in this line:
pasteRange.Value(11) = slabTemplateSheet.Range("slabTemp").Value(11)
Anyway, this is the code for the Named Range:
Sub UseNamedRange()
Dim slabTemplateSheet As Worksheet
Dim pasteRange As Range
Set slabTemplateSheet = Sheets("Sheet1")
' create the Named Range "slabTemp" (Named Range for Worksheet)
' you can manualy (or with variables) modify the Range("A1:F16")
slabTemplateSheet.Names.Add "slabTemp", Sheets("Sheet1").Range("A1:F16")
Set pasteRange = slabTemplateSheet.Range("slabTemp")
End Sub
It doesn't seem like you are trying to transfer the xlRangeValueXMLSpreadsheet XlRangeValueDataType enumeration of the cells; rather it sounds like you want 11 cells in a row.
with slabTemplateSheet.Range("slabTemp")
pasteRange.Resize(1, 11) = .Cells.Resize(1, 11).Value
end with

Copying Data from External workbook based on headers not in order to another workbook

I hope this is the right place to ask this question as I am on the verge of going crazy. I am so rusty and I have zero experience with VBA (only with C++, java)
The problem:
I am trying to copy data from one workbook to another.
Lets say I have a workbook (called DATA) with several worksheets filled with data. Each column of data has a unique heading (all headings on the same row).
On the other hand I have another workbook (called REPORT) with one worksheet that contains only the heading of the data (in one row). They are not in the same order as in DATA workbook. For example I have 3 headings in REPORT worksheet that can be found in different worksheets in DATA workbook.
I need to loop through all the worksheets in the DATA workbook and copy paste the whole column to the REPORT worksheet when the same heading is found.
This image may help to understand. Explanation
Thanks ALOT for your help in advance. I have searched alot for this code but found similar stuff but didnt manage to understand any .
First attempt at doing it, but getting an error of Run-time error '1004'.
Any help?
Dim MyFile As String
Dim ws As Worksheet
''Workbook that contains one worksheet with all the headings ONLY NO DATA
Dim TargetWS As Worksheet
Set TargetWS = ActiveSheet
Dim TargetHeader As Range
''Location of Headers I want to search for in source file
Set TargetHeader = TargetWS.Range("A1:G")
''Source workbook that contains multiple sheets with data and headings _
not in same order as target file
Dim SourceWB As Workbook
Set SourceWB = Workbooks("Source.xlsx")
Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
Dim SourceCell As Range
''Stores the col of the found value and the last row of data in that col
Dim RealLastRow As Long
Dim SourceCol As Integer
''Looping through all worksheets in source file, looking for the heading I want _
then copying that whole column to the target file I have
For Each ws In SourceWB.Sheets
ws.Activate
For Each Cell In TargetHeader
If Cell.Value <> "" Then
Set SourceCell = Rows(SourceHeaderRow).Find _
(Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not SourceCell Is Nothing Then
SourceCol = SourceCell.Column
RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If RealLastRow > SourceHeaderRow Then
Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
SourceCol)).Copy
TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
End If
End If
End If
Next
Next
Your question didn't specify what part of the problem you're actually stuck on, so I'll assume you don't know how to start. Note that nobody on here is going to provide you with the full working solution to your problem - that's upto you to figure out.
A few tips to get you to start working:
The first question you're going to ask yourself with problems involving multiple workbooks is typically going to be which workbook am i going to attach my macro to?
In your case, the REPORT Workbook looks like a saner option, since you probably want someone to be clicking on something in the report in order to generate it. You could also argue the other way around though.
Once you have chosen where to put your VBA, you have to establish a reference to the other workbook.
You either have to load the other Excel file from disk using Workbooks.Open, or have both Workbooks be open at the same time in your Excel Instance, which I'd recommend for you because it's easier. In this case simply establish the reference using the Workbooks object.
Dim exampleRefToDATA As Workbook: Set exampleRefToDATA = Workbooks("data.xlsx") ' or index
Then, cycle through each Worksheet
using something like For Each ws As WorkSheet In exampleRefToDATA.WorkSheets as your For Loop
In that Loop, loop through the first column using something like
For Each allName As Range In ws.Range(... for you to figure out ...)
In this Loop, you'll have to look if that name is in your REPORTS sheet by doing another loop like
For Each thisName As Range in Range(... seriously, there's enough on stackoverflow on how to properly iterate over the used range of a row ...)
Note how this Range() call is Equivalent to ActiveWorkbook.ActiveWorkSheet.Range, which is your Reports sheet.
Then just check for equality and copy the row over if necessary. Again, copying a row has also been covered here before.
Hope this was helpful for you.

How do I export specifc rows of data to another spreadsheet

I'm totally new to VBA and have a requirement to export specific rows based on a value within a specific column to another spreadsheet. Unfortunately I can't post an example so I'll try to explain. I have a sheet that consists of columns A to D and any number of rows. I need to copy all rows that contain [DV] anywhere in column C to another sheet in another spreadsheet.
I have another couple of variants that I would also need to do but I'm hoping if I get this one I can then modify it to suit my needs for the others.
You will have to read, each row under the column C (for each). At each row you will need to sub string the characters in that cell. If they match your condition (DV), than copy it to your desired worksheet.
You didn't provide any code, so this is the best I can help you. If you want more help, you will need to provide some code, and show where it is exactly that you are stuck.
this should do it :
Dim cl As Range
dim wb as workbook
dim ws as worksheet
set wb = workbooks.open("Your other workbook path & name")
set ws = wb.Sheets("destination sheet name")
For Each cl In Range("D1:D" & Range("D1").End(xlDown).Row)
If InStr(cl.Offset(0, -1).Value, "[DV]") > 0 Then
cl.EntireRow.Copy
ws.Range("A50000").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next cl

Copy the contents and formatting of a cell if a column within the row = today()

I'm currently building a small project planner in Excel that uses the current date to plot coloured blocks under a date column to depict which stage of the project we are currently at for a particular customer (see image below).
Behind each of the coloured blocks is a drop-down menu populated by a list on another sheet. My aim is to search for the current date in cell A1 ( populated using today() ) within all columns that follow the freezed panes (depicted by the black right hand border). When the current date is found, the value of in each of the coloured blocks should be copied into the corresponding cells so that as the project progresses, a line of coloured blocks are entered for each day (with the relevant text from the drop-down depicting the current stage of that block).
Currently I am using the following formula copied into all cells that follow the freeze:
=IF(F$1 = $A$1,$C2,"")
However, when the current date is changed this merely moves the copied blocks across to the relevant column without maintaining the old values from previous days.
I've also attempted this with a VLOOKUP so that I can enter it into a macro and run if from a button but the layout does not allow for a successful VLOOKUP.
The simplest solution I believe would be to have a button that allows the user to save the current state of the column with a header that matches the current date however it has been some time since I have coded in VBA and do not remember how to do this.
Any ideas? Thanks in advance.
Not sure if this is exactly what you're looking for, but here goes...
Sub ColorCode()
Dim ws As Worksheet
Dim rng As Range
Dim cel As Range
Set ws = ThisWorkbook.Sheets("SheetNameHere")
Set rng = ws.Range("F1:I1")***
For Each cel In rng
If cel.Value = ws.Range("A1").Value Then
ws.Range("C2:C8").Copy
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteFormats
End If
Next
End Sub
If you add that to a new module, you can assign it to a command button. I haven't had a chance to test it, but it cycles through the dates in the first row to see if they match the date in A1. If they do, it copies over the values and formats from C2:C8(change if you need to) into the rows underneath that date. You may need to change some of the ranges to suit your specific worksheet.
So your requirements seem fairly straightforward to me:
you need the tracker to identify the column with today's date
you need to establish a permanent value for each day as it occurs
you need the color of today's values to be added to the cell, and stay that way even after today's date has passed.
The formula you cite in your question, if copied across all cells, will clearly just provide a value on the column for today's date, and unless you use a circular reference to let it self assess and update its value on today's date, it will not retain information when tomorrow comes.
Your idea for a button would work if you want the user to control the time of update, or you could have code that runs either when the workbook opens or when the worksheet itself is activated (placing it in the appropriate object code under either Private Sub Worksheet_Activate() or Private Sub Workbook_Activate().
I think PermaNoob has a right idea of copying the value of the column and pasting the value (rather than the formlula) into that column, but what is missing is appropriate identification of the column containing today's date and the coloring of those cells (if you don't have some method of coloring them that you did not mention). Something like this might work either attached to a button as you suggest, or to the _Activate event as I suggest. This is untested but should give you an idea of how to approach it:
Sub UpdatePlanner()
'~~>dim variables and set initial values
Dim wb As Workbook
Set wb = Workbooks("NAME or INDEX of YOUR workbook")
Dim ws As Worksheet
Set ws = wb.Worksheets("NAME or INDEX of YOUR sheet")
Dim rngHeader As Range
Set rngHeader = ws.Range("F1", ws.Range("F1").End(xlToRight))
Dim rngDate As Range
Dim rngColumn As Range
Dim rngCell As Range
'~~>loop to find the column with today's date
For Each rngDate In rngHeader
If rngDate.value = ws.Range("A1").value Then
Set rngColumn = ws.Range(rngDate.Address, _
ws.Range(rngDate.Address).Offset(65536, 0).End(xlUp)) 'this assumes
'your column may not have a value in every row
Exit For
End If
Next rngDate
'~~>copy and paste the column values and formats
With rngColumn
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'~~>loop to add the color formatting (since I don't see this in your formula)
For Each rngCell In rngColumn
If rngCell.value = ws.Range(Cells(rngCell.Row, 3)).value Then
rngCell.Interior.Color = _
ws.Range(Cells(rngCell.Row, 3)).Interior.Color
End If
Next rngCell
End Sub