I have data in COLUMN H2. . I want to copy them somewhere else on the same spreadsheet.
But where I copy it will change one COLUMN at a time, as each column below gets filled, by the macro.
My existing macro successfully searches for, and pastes this column of data into an empty column below, such as B31. When I have 10 new pieces of data, the next time I run the macro, I want it to paste it into C31, in Column C (being the next empty row) The next time, D31.......etc.. My macro repeatedly grabs the data in H2:H11 and pastes it into B31, but overwrites that column each time I run the macro again. It is not "seeing" column B already having data placed there by running the macro before.... What is wrong with the code?
Range("H2:H11").Select Selection.Copy
Range("A31").Select
Range("A31:M31").End(xlToLeft).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Rows("1:10").EntireRow.Select
Application.CutCopyMode = False
Range("A31:M31").End(xlToLeft).Offset(0, 1).Select
should be
Range("M31").End(xlToLeft).Offset(0, 1).Select
Alternative solution is below (i've not tested it, as i'm not on my MS PC, sorry)
dim lRow as Long 'Output Row
lRow = 31 'Start at row 31
For i = 2 to 13 'Column B to Column M
'Count if there is any values in the columns
'(if there is a header then change the 0 to 1)
If Application.WorksheetFunction.CountA(ActiveSheet.Columns(i)) = 0 Then
For Each c in Range("H2:H11") 'Cycle through output values
ActiveSheet.Cells(lRow, i).value = c.Value 'Assign values
lRow = lRow + 1 'Increment row number
next c
exit for 'exit column loop
end if
next i
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'm trying to paste data at the end of the last filled row in a sheet, but my syntax overwrites my headers in Row 1 during the first iteration of the loop.
I'm running a looped code that copies and transposes variables from multiple spreadsheets on a single sheet. Variables are in two columns in the source files but go onto one row in the destination file. I use a "next row" function to place the data from the first column into the first empty row. I then want to use a "last row" function to append the data from the second column to the same row. However, during the first operation, my code doesn't know the difference between the first line of data and the variable names on the first row, so the second column data ends up shifted one row up from the first half of the data.
Dim lastrow As Long
Dim nextrow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
nextrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1
'assigns objects for the last filled row and the next unfilled row
wb1.Worksheets("Database").Range("B1:B578").Copy
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(nextrow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
DoEvents
Application.CutCopyMode = False
'copies the relevant data from Column B in Sheet 3 of the source file...
'then transposes and pastes into the next available row of the destination file
wb1.Worksheets("Database").Range("C32:C578").Copy
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(lastrow, 579).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
DoEvents
Application.CutCopyMode = False
'copies the relevant data from Column C in Sheet 3 of the source file...
'then tranposes and pastes into the same row as the previous function, beginning with...
'the next cell after the last data point
Is there a good way to adjust the syntax so that data does not paste to the first row of the spreadsheet? The goal is to have both columns from a source spreadsheet be pasted to the same row, and that each spreadsheet in the loop be pasted to the next empty row available. I appreciate any suggestions.
I think you want to change the cell you are pasting to, you don't want to paste in lastrow it should be nextrow.
You have;
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(lastrow, 579).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Change to;
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(nextrow, 579).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Looks like it wouldn't only be the first iteration of your loop but all of them. Try adding a breakpoint where you set lastrow and step through the execution to see where the issues arises, it will help to step through a few iterations of your loop and assess if it only happens once or not.
Assuming your header is at row 1, can you add coding after this:
lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
If lastrow=1 then lastrow=2
Want to do:
A.If only one row is present in the data sheet, copy and paste that lone row and paste it to the named sheet
B.if there are multiple rows of data, copy all then paste
Issues Having with Current Code:
it disregards the first if condition and goes straight to the next one which copies the range and everything below even if theres only one row of data present.
here's my code with the following condtions:
ws2 = source data sheet
wsA = sheet data will be pasted on
copied data if conditions are met should be pasted on the last available blank row in column A of WsA
k = ws2.Range("a6", ws2.Range("a6").End(xlDown)).Rows.Count
If k <= 1 Then
ws2.Activate
rngB.Select
Selection.Copy
wb2.Activate
wsA.Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
ws2.Activate
rngB.Select
Range(rngB, ActiveCell.End(xlDown)).Select
Selection.Copy
wb2.Activate
wsA.Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
data sheet
If there is no data below row 6 then ws2.Range("a6").End(xlDown) will extend down to the bottom of the sheet (so k > ~1000000)
To detect if only one row of data exists, try
If IsEmpty(ws2.Range("a6").Offset(1,0) then
' Only one row
Else
' More than one row
End If
And, head the advise to avoid select.
VBA code which finds the last non empty cell of Row 5, copies the data till that cell of Row 5 and pastes that data as values after transposing. I tried to record a macro by copying the data but it didn't work.
I'm assuming you're talking about excel vba. The below code copies from a range in sheet1 column A, down to the last data in the row ( you can change this to be only to row 5 if you have data after 5 that you don't want to copy). Then it transposes it on to sheet2.
update to only go to 5
Sub someMacro()
Dim answerRange As Range
Dim checkBlankRange As Range
Dim lastRowInRange As Long
Dim lastcolumn As Long
Set checkBlankRange = Worksheets("Sheet1").Range("A1:A5") 'changed to 1 to 5
lastRowInRange = 5 ' default to 5
lastcolumn = Sheets("Sheet1").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
'or you can use line below for last column
'lastcolumn = Sheets("Sheet1").Cells(1, Sheets("Sheet1").Columns.Count).End(xlToLeft).Column
For Each cell In checkBlankRange
If cell.Value = "" Then 'first empty cell
lastRowInRange = cell.row 'get the row number of the empty cell
Exit For
End If
Next cell
Set answerRange = Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(lastRowInRange, lastcolumn))
answerRange.Copy
ActiveWorkbook.Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub
if the data is always going to be in those colums you wont need alot of the code and you can just use what you had in your recorded macro - cleaned up to remove selects
Sub simpleVersion()
Sheets("Sheet1").Range("A1:F5").Copy
Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub
I currently have this code
Sheets("Pivot_Table_Non_Closed_Area").Range("E7:L7").Copy
'Pastes the data from the sheet above in the next avaliable row.
Sheets("Tracking_Table_Non_Closed_Area").Cells(Rows.Count, "C").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Tracking_Table_Non_Closed_Area").Select
n = Cells(Rows.Count, "C").End(xlUp).Row
Range("A" & n) = Date
Range("B" & n) = Time
This is how my current code presents it:
https://www.dropbox.com/s/p99kh0y3x2vsbo2/Currently_Presents.JPG?dl=0
but I can not seem to work out how to change it from copying rows of data and pasting rows into copying from columns of data and pasting into columns
This is how I want the new code to present the data:
https://www.dropbox.com/s/krkdjlculdqpckn/Wish_for_it_to_Be_Presented.JPG?dl=0
Hope this makes sense
Edit:
This is how my current code now looks after all the help, but stills struggling with the Date and time
Sheets("Pivot_Table_002").Range("B10:B19").Copy
Sheets("Sheet1").Cells(7, Columns.Count).End(xlToLeft).Offset(0, 1). _
PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
n = Cells(7, Columns.Count).End(xlToLeft).Column
Range("A" & n) = Date
Range("B" & n) = Time
Thanks
Edit - the Date and Time continued
You are setting the destination for Date and Time using a Range, but now that n represents the last-occupied column, you need to change that logic. Let's use the Cells construct, which I think reads better in this case:
Sheets("Tracking_Table_Non_Closed_Area").Cells(7, n) = Date
Sheets("Tracking_Table_Non_Closed_Area").Cells(8, n) = Time
Here's how .Cells is doing the work:
.Cells(row_identifier, column_identifier)
With that, you should be all set!
Edit - the Date and Time
Let's apply the same strategy to the Date and Time that we did to the column-ish data. The original design does the following:
n = Cells(Rows.Count, "C").End(xlUp).Row
What's actually happening there? n is a number. Specifically, n is the row number of the last-occupied cell in column "C". We're interested in getting the last-occupied column in a row instead -- let's say, to stick with the example below, we the last-occupied column in row 7:
n = Cells(7, Columns.Count).End(xlToLeft).Column
Boom! Now that n holds the last-occupied column number, you can apply the same strategy that you have in your last two lines to write in the Date and Time per the screenshots you provided.
Initial Answer:
I think a dissection of your already-existing code will help you along here, so let's get after it!
The copy/paste action is happening on these two lines:
'This line does the copying
Sheets("Pivot_Table_Non_Closed_Area").Range("E7:L7").Copy
'This line does the pasting
Sheets("Tracking_Table_Non_Closed_Area").Cells(Rows.Count, "C").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
(indentation added by me for clarity on the pasting line as _ is a multi-line indicator.)
Let's talk about the copy:
Sheets("Pivot_Table_Non_Closed_Area") '<~ this specifies the worksheet
Range("E7:L7") '<~ this specifies the range, which is a row-ish
' group of cells from E7 to L7
Copy '<~ this is the copy method
So, if you wanted to work with a column-ish group of cells instead, you'd adjust the Range. For the sake of an example, let's say you're interested in the column-ish group of 5 cells from E7 to E11. If you wanted to copy that group, you would write:
Sheets("Pivot_Table_Non_Closed_Area").Range("E7:E11").Copy
Nice! Now let's dive into the paste:
Sheets("Tracking_Table_Non_Closed_Area") '<~ this specifies the worksheet
Cells(Rows.Count, "C").End(xlUp).Offset(1) '<~ this starts in the last cell in
' column C (Rows.Count = the count
' of all the rows, i.e. 1 million-
' ish in Excel 2007+ or 56K-ish in
' Excel 2003). Then, .End(xlUp)
' simulates hitting Ctrl + Up on
' the keyboard, bringing you to the
' last occupied cell in column C.
' Finally, .Offset(1) increments
' that location by 1 row, bringing
' you to the cell immediately below
' the last occupied cell in
' column C.
PasteSpecial Paste:=xlPasteValues (then options) '<~ this does the pasting, with
' values-only (along with some
' other options, which aren't that
' important here.
Cool, right? Finding the last occupied row and writing information immediately below it is a cornerstone of VBA, so I would recommend reading this killer writeup on that subject. So what if you wanted to paste the column-ish area we copied above one column right of the last occupied column in row 7? We could write this:
Sheets("Tracking_Table_Non_Closed_Area").Cells(7, Columns.Count).End(xlToLeft).Offset(0, 1). _
PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Hope that helps!