VBA to copy data into Columns - excel

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!

Related

VBA Left Function?

I'm relatively new to VBA and have some code I wrote that seems like it should be straightforward but is not behaving as expected. I am trying to separate my primary WorkSheet (GAWi) into three other worksheets (LWi, WMi, & OTi) based on the first letter in column H. Basically if the first letter is "L" I want that row to be copied and pasted onto sheet LWi and then deleted from the original sheet. Then if it is W it goes onto WMi and if it is A it goes onto OTi. It is functioning properly for the first two If statements (placing items that begin with L & W onto the correct sheets), but for the last one items that begin with P and 0 are also being placed onto sheet OTi. I'm at a complete loss, it seems pretty easy and I can't figure out where I went wrong. Any advice would be much appreciated, also I'm sure this code is pretty unelegant by most standards so any tips on how to shorten it would also be welcomed-I've just started getting into VBA in the last couple weeks. Thank so much!
Sheets("GAWi").Select
Columns("H:H").Select
Dim lwr As Range
Set lwr = ActiveSheet.UsedRange
For i = lwr.Cells.Count To 1 Step -1
If Left(lwr.Item(i).Value, 1) = "L" Then
lwr.Item(i).EntireRow.copy
Sheets("LWi").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Sheets("GAWi").Select
lwr.Item(i).EntireRow.Delete
End If
If Left(lwr.Item(i).Value, 1) = "W" Then
lwr.Item(i).EntireRow.copy
Sheets("WMi").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Sheets("GAWi").Select
lwr.Item(i).EntireRow.Delete
End If
If Left(lwr.Item(i).Value, 1) = "A" Then
lwr.Item(i).EntireRow.copy
Sheets("OTi").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Sheets("GAWi").Select
lwr.Item(i).EntireRow.Delete
End If Next i
there's a main flaw in your logic: the use of UsedRange
despite being it a 2D range, its Item() property would act as if it were a 1D array with one row listed after another
so that were "A1:H10" (eight columns) the address of UsedRange, UsedRange.Item(1) would point to "A1", UsedRange.Item(8) would point to "H1" and UsedRange.Item(9) would point to "A2" …
so you have to loop through the cells of column H only
Then there's a coding flaw, which is the use of all those Select/Selection: get in the habit of always use explicit range reference qualified up to their parent worksheet and workbook
. This can be reached, for instance, with the use of With... End With construct
here's a possible code (explanations in comments):
Option Explicit
Sub TransferRows()
Dim i As Long
With Sheets("GAWi") ' reference "source" sheet
For i = .Cells(.Rows.Count, "H").End(xlUp).Row To 1 Step -1 ' loop backwards from referenced sheet column H last not empty cell row index to 1
Select Case UCase(.Cells(i, "H").Value) ' check for referenced sheet column H current row content
Case "L"
TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("LWi") ' pass referenced sheet current row "used" range and "LWi" destination sheet to the helper sub
Case "W"
TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("WMi") ' pass referenced sheet current row "used" range and "WMi" destination sheet to the helper sub
Case "A"
TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("OTi") ' pass referenced sheet current row "used" range and "OTi" destination sheet to the helper sub
End Select
Next i
End With
End Sub
Sub TransferRow(sourceRng As Range, destSht As Worksheet)
With destSht
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, sourceRng.Columns.Count).Value = sourceRng.Value
End With
sourceRng.Delete xlUp
End Sub
As you see, other than the amendements due to the preface explanations I put in there:
the use of Select Case syntax instead of If Then End If
which I think is much clearer and would also correct a minor logic flaw of your orginal code: once a check is positive there's no need to run other ones (this you could have obtained by means of If - Then - ElseIf - Endif construct)
the use of a "helper" sub to demand the repetitive code to
which gives you much more control over your code and helps its maintenance
the use of Cells(Rows.Count, colIndex).End(xlUp) pattern
which is the most frequently used one to get the reference to the last not empty cell in some colIndex (be it a number or a letter) column
Thanks to HTH's great response I was able to clean up my code a bit and think I got it figured out. I opted to stick with the If Then Else If format since I am not too familiar with using Case yet. Here's the first section of it, I just repeated the copy, paste, delete row for each starting letter.
Set rng = Range("GAWi!H:H")
For k = rng.Cells.Count To 1 Step -1
If Left(rng.Item(k).Value, 1) = "W" Then
With rng.Item(k)
.EntireRow.copy
Sheets("WMi").Activate
ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.EntireRow.Delete
End With
ElseIf Left(rng.Item(k).Value, 1) = "L" Then....
This is running well for my purposes but if anyone has more suggestions they are much appreciated.

How to paste to the last filled row without including first row (headers)?

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

Copying values, applying a formula and pasting the results as values. All operations in different Sheets - VBA Macro Excel

I am trying to create a Macro in Excel with VBA, that builds a bunch of different email addresses with a person's first, middle and last name and the company's email domain. I then want to verify these different email addresses with an email bulk tester which is another application.
In Sheet1 I have the input data for the email addresses in the following columns:
First names: F
Middle names: G
Last names: H
Email domains: I
Since there are 52 different persons whose email addresses I want to find, all the data is thus in cells F2:I53.
On Sheet2 I would need to fill in the first, middle and last name as well as the email domain of each person separately in cells B2:B5. On the same Sheet, 46 different possible email addresses will be generated for each person in cells G2:G47.
On Sheet3, I want to copy paste all 46 different email addresses as values. For the first person, I want to copy paste these 46 email addresses into cell A3. For the second person I want to copy paste them into cell A49, for the third person into cell A95, etc. Since I wanna do this for 52 persons, the last populated cell should be A2394.
Here you can take a look at this table which I would normally have in excel:
https://docs.google.com/spreadsheets/d/1kWPfscdnz_TCS7K1H3to1rBgRzJ9XSBH8L7rjKhlTnc/edit?usp=sharing
Thus the macro is supposed to do the following in the first iteration:
Select and copy cells F2:I2 on Sheet1
Go to Sheet2 and special paste them (transpose) in cells B2:B5
Select and copy cells G2:G47
Go to Sheet3 and past them as values into cell A3
In the second iteration, the macro is supposed to do the following:
Select and copy cells F3:I3 on Sheet1
Go to Sheet2 and special paste them (transpose) in cells B2:B5
Select and copy cells G2:G47
Go to Sheet3 and past them as values into cell A49
As you can see in 1) and 2), the row number increments after every iteration. This whole process is thus to be repeated 52 times. Below, you can see the macro I have created
Sub Macro1()
Dim i As Integer
Dim m As Integer
For i = 1 To 52
'selecting the first, middle and last name (columns I to F)
m = i + 1
Range("F" & m & ":I" & m).Select ' maybe I need to use the Indirect function here?
Selection.Copy
Sheets("Sheet2").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
' Maybe give excel some time to calculate the email addresses first?
Application.Calculate
Range("G2:G47").Select
Selection.Copy
Sheets("Sheet3").Select
'Find the first empty cell in column A
Range("A1").End(xlDown).Offset(1, 0).Select
'pasting the email addresses as values
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'end of iteration
Next i
End Sub
However, when I run the macro, the cells A3:A2394 on Sheet3 only contain the # sign (see google sheet). Unfortunately, I have no idea where exactly the error occurs. My suspicion was that I need to give excel some time to calculate the 46 different email addresses in G2:G47 in Sheet2, so I added the "Application.Calcuate" command, but it also didn't work.
Would be awesome if someone of you could help.
Thanks in advance,
Kevin
I cannot comment so i have to put it as answer.
The problem i guess, is that your code is not specific to where range is selected. To improve your code, you might want to try:
dim wSheet1 as Workbook
dim wSheet2 as Workbook
dim wSheet3 as workbook
set wSheet1 = Workbooks("Sheet1")
set wSheet2 = Workbooks("Sheet2")
set wSheet3 = Workbooks("Sheet3")
then use:
wSheet1.Range(....)
to specify which sheet you are referring to rather than .select.
Below code is now working:
Sub Macro1()
Dim i As Integer
Dim m As Integer
Dim wSheet1 As Worksheet
Dim wSheet2 As Worksheet
Dim wSheet3 As Worksheet
Set wSheet1 = Sheets("Sheet1")
Set wSheet2 = Sheets("Sheet2")
Set wSheet3 = Sheets("Sheet3")
For i = 1 To 52
'selecting the first, middle and last name (columns I to F)
m = i + 1
wSheet1.Range("F" & m & ":I" & m).Copy
wSheet2.Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
' Maybe give excel some time to calculate the email addresses first?
Application.Calculate
wSheet2.Range("G2:G47").Copy
'Find the first empty cell in column A and paste as values
wSheet3.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'end of iteration
Next i
' code from the macro runner
'Range("F2:I2").Select ' question is how to select the same range next time, only one row lower?
'Selection.Copy
'Sheets("Sheet2").Select
' pasting the name (as transpose)
'Range("B2").Select
'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
' selecting all the possible email addresses
'Range("G2").Select ' shouldn't it be Range("G2:G47).Select ?
'Range(Selection, Selection.End(xlDown)).Select
'Application.CutCopyMode = False
'Selection.Copy
' paste all possible email addresses as values into Sheet3
'Sheets("Sheet3").Select
'Range("A1").Select ' Question is how to select the first empty row in column A of that Sheet
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Excel Macro to copy from sequential rows to constant location, then from constant location back to matching row

I'm making my first macro in order to save having to perform 2500 copy-pastes. I have a long and complicated worksheet that takes two variables as inputs and returns a single value, and another sheet with 2500 pairs of these variables.
To keep things in the same sheet, I've linked the formula sheet inputs to J2 and K2 on my variable sheet, and the output to L2. My goal is to populate a third column next to the first two with the results for that row, by copying the two values to J2 & K2, then copying from L2 to the appropriate cell in the third column. As my macro is currently, it returns to the same cell in the third column every time, based on an offset from L2 as the last active cell.
I've tried searching for help on how to either increment the last paste operation, or to keep the active cell referencing the start point of the macro in order to keep things in the same row, but was unsuccessful. Any help would be appreciated.
ActiveCell.Range("A1:B1").Select
Selection.copy
Range("J2:K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L2").Select
Application.CutCopyMode = False
Selection.copy
ActiveCell.Offset(43, -5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sub TT()
Dim sht As Worksheet, c As Range
Set sht = ActiveSheet
For Each c In sht.Range("A1:A2500").Cells
sht.Range("J2").Value = c.Value
sht.Range("K2").Value = c.Offset(0, 1).Value
sht.Calculate
c.Offset(0, 2).Value = sht.Range("L2").Value
Next c
End Sub

Copy data from one column, paste in first empty column

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

Resources