I am having problems with getting a loop to run.
I have a Source1 spreadsheet with a list of values in Column A on the CC's tab. Each number is to be copied individually into Cell B1 on the Template tab of the Source2 spreadsheet.
Cell B1 triggers a consolidation of information (mainly indexed info) and displays it in a template - an aggregate picture of lots of background data. I then Copy A1:K71, and paste this into the Output tab of the Source1 spreadsheet.
I want to work down the list in Column A of the CC's tab, and append each output from the Source2 spreadsheet into the Output tab automatically.
I have the copy/paste working, but I am having problems with the loop.
Selection.Copy
Windows("Source2.xlsx").Activate
Range("B1").Select
ActiveSheet.Paste
Range("A1:K71").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Source1.xlsm").Activate
Sheets("Ouput").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
#Andrew, after reading and re-reading your question, I don't think a loop of any kind is necessary. The macro-recorder results you gave above provide information about how you can solve this. I tested this by creating a Source1 Workbook with values placed in column A on a sheet labeled CC's. I also added a sheet labeled Output. Then, I opened a second Workbook with a sheet labeled Template. Here is the sub-procedure I used to produce the result I think you are describing above:
Sub AndrewProject()
' COMMENT: Declare variables used throughout this procedure
Dim InitialVals As Range
Dim OutputVals As Range
Dim FinalResults As Range
Dim FinalOutput As Range
Dim cell As Variant
' COMMENT: Set the range objects so they are easier to manipulate
Set InitialVals = Workbooks("Source1").Worksheets("CC's").Range("A2:A72")
Set OutputVals = Workbooks("Source2").Worksheets("Template").Range("B2:B72")
Set FinalResults = Workbooks("Source2").Worksheets("Template").Range("A2:K72")
Set FinalOutput = Workbooks("Source1").Worksheets("Output").Range("A2:K72")
' COMMENT: This line copies the values in Source1 Workbook and pastes them into Source2 Workbook
InitialVals.Copy
OutputVals.PasteSpecial xlPasteValues
' COMMENT: Additional code goes here to create the desired output. To simplify things, I put a
' function in Source2, column K that concatenates the string "Output" with InitialVals copied
' from Source1. To emulate your Source2 Template, I placed random values between 1 and 1000 in
' Cells A2:A72 and C2:J72.
' COMMENT: Copy the FinalResults from Source2 "Template" tab into the Source1 "Output" tab
FinalResults.Copy
FinalOutput.PasteSpecial xlPasteAll
End Sub
OK #Andrew...this has got to be my last attempt. I believe this answers your question.
Sub AutomateIt()
' Declare your variables
Dim cell As Range
Dim Src1CC As Range
Dim Src2Template As Range
Dim Src2Calcs As Range
Dim Src1Output As Range
Dim NextRow As Long
Dim count As Integer
' Set the ranges so they can be manipulated
Set Src1CC = Workbooks("Source1").Worksheets("CC").Range("A1")
Set Src2Template = Workbooks("Source2").Worksheets("Template").Range("B1")
Set Src2Calcs = Workbooks("Source2").Worksheets("Template").Range("A1:K72")
Set Src1Output = Workbooks("Source1").Worksheets("Output").Range("A1:K72")
Src2Template.ClearContents
count = 0
' Loop through all the cells and calculate stuff
For Each cell In Src1CC.Range(Src1CC, Src1CC.End(xlDown))
'Determine the next empty row (plus a space for readability)
NextRow = Cells(Rows.count, 1).End(xlUp).Row + 2
'Send a copy of the Src1CC cell value to the Src2Template
cell.Copy Src2Template
'Re-calculate A1:K72 based on cell value
Src2Calcs.Calculate
'Copy Src2Calcs results and paste to Source1 Output
Src2Calcs.Copy
Src1Output.PasteSpecial xlPasteValues
count = count + 1
MsgBox "You have pasted " & count & " results."
'Change Src1Output Range so that the next paste is the next blank row
'plus one additional row for readability.
Set Src1Output = Workbooks("Source1").Worksheets("Output").Range(Cells(NextRow, 1), Cells(NextRow, 11))
Next cell
End Sub
Related
I am trying to write a macro that copies data from a form (Contractor Entry Form, range "U5:AT5") and pastes it to a database (CONTRACTOR DATABASE).
When a record is edited, it requests the Employee ID# and finds that row on the database, and pastes that row number reference temporarily into cell Contractor Entry Form "L1".
I need to then paste the copied data to the database on that row number (-1) that is referenced in cell "L1". If there is no value in "L1" that means it is a new entry and should then just paste to the last row -- as opposed to pasting over a previous record row.
Help, please. My code is here--
Sub ContractorEntry
Range("U5:AT5").Copy
Sheets("CONTRACTOR_DATABASE").Select
Dim R As Integer
R = Worksheets("CONTRACTOR ENTRY").Range("L1").value
'note-- if there is a value in CONTRACTOR ENTRY L1>0 then
' (it represents a row number --- paste value to that row -1 onto
' Contractor Database sheet.
If Worksheets("CONTRACTOR ENTRY").Range("L1") > 0 Then
Sheets("CONTRACTOR_DATABASE").Cells (R -1, 1)
Selection.PasteSpecial
End If
Else
'if there is no value in cell L1 then the following to just paste to the next blank row
lMaxRows = Cells(Rows.Count, "A").End(xlUpSelection.PasteSpecial.Row
Range("A" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks :=False, Transpose:=False
'This returns to the contractor entry form and clears contents
Sheets("CONTRACTOR ENTRY").Select
Range("D3:M1").Select
Selection.ClearContents
'Should go back to Contractor Entry Form for Name and a new entry in cell D3
Range("D3").Select
End Sub
There's almost never any need to use Select/Activate see here for guidelines on how to improve your code: How to avoid using Select in Excel VBA
Something like this should work:
Sub ContractorEntry()
Dim rw, wsInput As Worksheet, wsDB As Worksheet
'use worksheet varaibles for easier maintenance
Set wsInput = ThisWorkbook.Worksheets("CONTRACTOR ENTRY")
Set wsDB = ThisWorkbook.Worksheets("CONTRACTOR_DATABASE")
rw = wsInput.Range("L1").Value - 1
'if row not present then get next empty row
If rw < 1 Then rw = wsDB.Cells(Rows.Count, "A").End(xlUp).Row + 1
'copy over values directly (no copy/paste)
With wsInput.Range("U5:AT5")
wsDB.Cells(rw, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
With wsInput
.Activate
.Range("D3:M1").ClearContents
.Range("D3").Select
End With
End Sub
I have code that creates a bunch of new sheets, names them, and then loops through them searching a dataset for the name of the sheet and transposing data rows with a value matching the name of the sheet.
I've gotten it to work transposing each row to the next column to the right, but for printing purposes, I'd like it to move to the bottom of the last pasted cell, skip a row (or better yet, insert a page break), and then paste the next one.
Something about the way I've tried to tell it to count the rows, move down, and then start again, isn't working. It appears to be pasting multiple times over previously pasted data.
I've tried several different ways of counting the rows and adding a row, or inserting a page break, but I can't get it working. I thought maybe I needed to move the rowcount function out of the IF statement, but that didn't work either.
Sub Franchise_Data4()
'searches Raw Data sheet for the Franchise ID associated with each sheet name; then transposes each relevant row onto the associated sheet'
Dim Scol As Range, Cell As Object, rawdata As Worksheet, ws As Worksheet, lc As Long, rowcountA As Integer, startR As Integer, labels As Range
Set rawdata = ThisWorkbook.Worksheets("Raw Data")
Set Scol = rawdata.Range("$C$2:$C$2000") 'Franchise ID column on Raw Data sheet'
Set labels = ThisWorkbook.Worksheets("Raw Data").Range("A1:AZ1")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Raw Data" And ws.Name <> "Pivot" Then
With ws 'cycles through all of the sheets with Franchise ID's as the name
startR = 0
For Each Cell In Scol 'should scan the C column on the Raw Data sheet'
If IsEmpty(Cell) Then Exit For
If Cell.Value = ws.Name Then 'checks for cells that contain the same Franchise ID as the current sheet in the cycle'
Cell.EntireRow.Copy
ws.Cells(startR + 1, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
labels.Copy
ws.Cells(startR + 1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
End If
rowcountA = Cells(Cells.Rows.Count, "A").End(xlUp).Row
startR = rowcountA + 1
Next
End With
End If
Next ws
Application.CutCopyMode = False
End Sub
It appears to paste the first data set correctly, then move down 1 row (instead of the rowcount+1) and paste again. Then I guess it either stops, or it continues pasting the rest in the same spot.
You need to fully qualify the Worksheet that the Cells are on.
rowcountA = Cells(Cells.Rows.Count, "A").End(xlUp).Row
There's an implicit ActiveSheet here, not a reference to ws as you would want. You already have a With ws...End With so change this line to:
rowcountA = .Cells(.Rows.Count, "A").End(xlUp).Row
Note that there are other instances where you are "repeating" the ws instead of fully taking advantage of the With ws...End With.
I have a vba macro that is attempting do some light formatting of data in one workbook then paste the formatted data into the bottom of a table in another workbook. For some reason I am getting a Run-time error '1004': PasterSpecial method of Range class failed when it goes to paste and I can't figure out why.
Sub Add_Data()
'
' Add_Data Macro
'
' Insert column to the left of column B in raw data
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Copy columns A-N in raw data
Range("A2").Select
Selection.End(xlDown).Select
Range("A2:N" & ActiveCell.Row).Select
Selection.Copy
' Remove filter from column B of ongoing report
Windows("Ongoing Report.xlsm").Activate
ActiveSheet.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2
' Paste data from raw data at bottom of ongoing report
Range("A2").Select
Selection.End(xlDown).Select
Range("A" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Filter column B of ongoing report to remove blanks
ActiveSheet.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2, _
Criteria1:="<>"
Copy Range to Range
Carefully adjust the values in the constants (Const) section.
It is assumed that the code will be in the workbook containing the
RawData worksheet.
Tips
The last or first used cells (rows, columns) are usually calculated
from the bottom or from the right. I might be wrong here if you have data below Source Range.
Anything containing Select and Active is best avoided, if possible.
When pasting values, using Copy(Paste) is easily (best) avoided.
The Code
Sub Add_Data()
Const cSource As String = "RawData" ' Source Worksheet Name
Const cCols As String = "A:N" ' Source Columns Range Address
Const cFr As Long = 2 ' Source/Target First Row Number
Const cWbTarget As String = "Ongoing Report.xlsm" ' Target Workbook Name
Const cTarget As String = "Sheet1" ' Target Worksheet Name
Const cTgt As String = "A" ' Target Column Range
Dim rngS As Range ' Source Range
Dim rngT As Range ' Target Range
' In Source Worksheet
With ThisWorkbook.Worksheets(cSource)
' Insert column to the left of column B in raw data.
.Columns("B:B").Insert Shift:=xlToRight, _
CopyOrigin:=xlFormatFromLeftOrAbove
' In Source Columns Range
With .Columns(cCols)
' Calculate and create a reference to Source First Column Last Used
' Cell.
'Set rngS = .Cells(.Row, .Column).End(xlDown)
Set rngS = .Cells(.Rows.Count, .Column).End(xlUp)
' Calculate and create a reference to Source Range.
Set rngS = .Rows(cFr).Resize(rngS.Row - cFr + 1)
End With
End With
' In Target Worksheet
With Workbooks(cWbTarget).Worksheets(cTarget)
' Remove filter from column B of ongoing report
.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2
' Calculate and create a reference to Target Column First Empty Cell.
Set rngT = .Cells(.Rows.Count, cTgt).End(xlUp).Offset(1)
' Calculate and create a reference to Target Range i.e. adjust the size
' to be equal to the size of Source Range.
Set rngT = rngT.Resize(rngS.Rows.Count, rngS.Columns.Count)
' Copy values from Source Range to Target Range.
rngT = rngS.Value
' Filter column B of ongoing report to remove blanks
.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2, Criteria1:="<>"
End With
End Sub
You lose your clipboard data when you unfilter the table in your destination workbook. They unfiltering first then copying the original range. Also, there almost never a good reason to use select. It can slow down your macros.
Sub Add_Data()
Dim home As Worksheet: Set home = ActiveWorkbook.Sheets("sheet name 1")
Dim dest As Worksheet: Set dest = Windows("Ongoing Report.xlsm").Sheets("sheet name 2")
'Insert column to the left of column B in raw data
home.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Remove filter from column B of ongoing report
dest.Sheets("sheet name here").ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2
'Copy columns A-N in raw data
home.Range("A2", Range("A2").SpecialCells(xlEnd).Copy
'Paste data from raw data at bottom of ongoing report
dest.Range("A" & dest.Range("A2").End(xlDown).Row + 1).PasteSpecial xlPasteValues
'Filter column B of ongoing report to remove blanks
Dest.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2, Criteria1:="<>"
End Sub
Untested from my mobile, but hope this points you in the right direction.
I'm looking to import data from another file (combinedWorkbook) to my master file (the file which is running the code) using a vlookup. I then need it to drag the vlookup down to the bottom row of data (using column M in the masterfile as a reference to when the data ends) with cell I15 being the starting point for the vlookup in the masterfile.
The problem I'm having is that when running the macro the vlookup is happening in cell M10 in my masterfile, not dragging down the vlookup to the end of the data and not referencing the combinedWorkbook.
Any help would be appreciated.
This is what I got so far
Dim combinedBook As Workbook
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox ("Select Unpaid Capital Extract")
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
ThisWorkbook.Activate
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-8],combinedWorbookSheet1!R1C1:R700000C2,2,0)"
Range("M16").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Range("I15:I60297").Select
Range("I60297").Activate
Selection.FillDown
Range("I15").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("I15").Select
combinedWorkbook.Close False
There are simply too many unknowns in your code to give a specific answer.
Some observations:
1) Always use Option Explicit at the top of your code, it will pick up mistakes and inconsistencies for you.
2) Watch out for unused variables declared in your code
3) Always specify which workbook and worksheet you are working with; don't just put Range ... or Cells.... this leads to all sorts of bugs.
4) Your VLOOKUP syntax for working with another workbook needs to be of the order
'[" & combinedWorkbook.Name & "]Sheet1'
5) xlsx are not text files btw re: your filter
6) For the rest i.e. where you want formulas to go, how you are determining last row etc I am just having to guess. Be specific when coding and try bullet pointing pseudo code first so you are clear what is going on at each stage.
Option Explicit
Sub test()
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox "Select Unpaid Capital Extract"
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
'Assuming M is used to find last row in targetWorkbook
Dim lastRow As Long
With targetWorkbook.Worksheets("Sheet1") 'this wasn't specified (specify appropriate sheet name)
lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row
'Assuming I is where formula is being put
.Range("I15:I" & lastRow).FormulaR1C1 = _
"=VLOOKUP(RC[-8],'[" & combinedWorkbook.Name & "]Sheet1'!R1C1:R700000C2,2,0)"
combinedWorkbook.Close False
End With
End Sub
As I understood you need to apply a vlookup formula in your master file gathering data from another workbook.
The proper strucutre is as followed:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],[Book1]Sheet1!R1C5:R23C6,2,FALSE)"
The first bold text is the place of the value you are looking for, relative to the active cell.
The second bold text is the position of your reference table in your other workbook ( here it is book 1).
You can apply this formula to your masterfile by using a loop.
Dim lastRow as Integer
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "M").End(xlUp).Row
endCount = 15 + lastRow
For i = 15 to endCount
ActiveSheet.Cells(i,13).FormulaR1C1 = "=VLOOKUP(RC[-8],[combinedWorkbook]Sheet1!R1C1:R700000C2,2,FALSE)"
next i
This will apply the vlookup formula in the column I starting row 15 searching for the value in the same row but 8 column before (column "A") and will apply for as many row as there are value in the column M.
i want a macro to paste values from clipboard ( values that i have copied from another source)
in transpose to last non empty cell in row E in worksheet "sheet1"
any help?
Try something like this:
Sub WriteFromClipboard()
Dim refRow As Integer
Dim Data As DataObject
Dim DataText As String
On Error Resume Next
'Get row to write data:
refRow = 1 + ThisWorkbook.Sheets("Sheet1").Columns(5).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
If Err.Number > 0 Then
refRow = 1
End If
Err.Clear
'Get data from clipboard:
Set Data = New DataObject
Data.GetFromClipboard
DataText = Data.GetText
'Write data from clipboard on the spreadsheet:
If Err.Number > 0 Then
MsgBox "Clipboard doesn't contain valid data."
Else
ThisWorkbook.Sheets("Sheet1").Cells(refRow, 5).Select
ThisWorkbook.Sheets("Sheet1").Paste
End If
End Sub
function findLastRowInCol(wks as excel.worksheet, col as long)
dim rng as range
with wks
set rng = .cells(.rows.count, col).end(xlup)
findLastRowInCol = rng.row
end with
end function
To test from the Immediate pane:
debug.print findLastRowInCol(thisworkbook.sheets("sheet1"), 5)
This will give you the row of the last non-empty cell in the specified column. Note that this may not be the last used row of the worksheet; selecting a different column may give you a different result depending which is that column's last non-empty cell.
Edit: replaced activesheet with "sheet1"
Edit: sample code to use in another macro to paste in from some other source,
thisworkbook.sheets("sheet1").cells(findLastRowInCol(thisworkbook.sheets("sheet1"), 5), 5).pastespecial paste:=xlAll
If pasting from another Excel sheet or to strip formatting, you can use e.g. "xlPasteSpecialValues"
Edited to add: to paste a row from another worksheet and transpose, use the above as far as ".pastespecial" then use some variation on:
.pastespecial paste:=xlpastevalues, transpose:=True
The simplest implementation is,
sub PasteToE()
thisworkbook.sheets("sheet1").cells(findLastRowInCol(thisworkbook.sheets("sheet1"), 5),5).pastespecial paste:=xlpastevalues, transpose:=True
end sub
Add a commandbutton to the other worksheet and assign this macro to it. Select your range and copy it, then click the button.