I am trying to create an excel macro which finds the last column of a sheet and then selects the entire column. However, this column will always be different- some days it will be column 'H', other days will be column 'GX' as the data in the sheet is constantly updated. So far I have seen how you can find the last column and then delete it, but it specifically refers to that certain column once the macro runs again. I need it to always refer to the last column, no matter what column that may be. Thanks!
Here is the code. I am new to VBA, etc. and this was created through the macro recorder and other things I found online so bear with me!
`Sub Macro11()
Sheets("Sheet25").Cells(1, 1).Activate
ActiveCell.SpecialCells(xlLastCell).Select
lastCol = ActiveCell.Column
Columns("W:W").Select
Selection.Delete Shift:=xlToLeft
End Sub`
Here is the sample code
Avoid using Select /Activate in your code. To know why refer this link
Sub Macro11()
Dim LastCol As Long
With ThisWorkbook.Sheets("Sheet25")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Columns(LastCol).Delete
End With
End Sub
Related
I'm very new to VBA and learning through code I find on the internet, and also using macros to see code.
I have an imported xls with three columns of data. I have code that does the following:
Inserts a new column A
Deletes column B
Delete rows with no data
Inserts two columns
So far - okay. What I am then trying to do is insert a number starting at 1 in column A1 and sequentially filling in until all rows with records have a number. I used a macro to see the code, but the range will vary (i.e. there are not always 52 rows in my import).
Is there a way to make this dynamic by only applying a number where there is data in the row (Column B will always have data)?
Thanks in advance - all help greatly appreciated!
Sub DeleteBlankRows()
Dim x As Long
Dim lastRow As Long
Dim A As Long
' INSERT A NEW COLUMN A FOR NUMERICAL SEQUENCE
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'DELETE ALL BLANK ROWS
With ActiveSheet
For x = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(.Rows(x)) = 0 Then
ActiveSheet.Rows(x).Delete
End If
Next
End With
'add two new columns for population
ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Columns("A:B").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "#"
'code to enter a sequential number starting at 1 for every row that has a record
ActiveSheet.Range("A1").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = "1"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A52"), Type:= _
xlFillSeries
ActiveCell.Range("A1:A52").Select
ActiveWindow.SmallScroll Down:=15
End Sub
There are a lot of stuff to improve your my code, but this should get you started
Some things to begin:
Use option explicit at the top of your modules so you don't have unexpected behavior with undefined variables
Always indent your code (see www.rubberduckvba.com a free tool that helps you with that)
Try to separate your logic defining variables and the reusing them
Name your variables to something meaningful and easy to unterstand (avoid x or r)
Write the code steps in plain English first, then develop it in VBA
Check the code's comments, and adapt it to fit your needs
Code
Public Sub PrepareFormat()
' Set a target sheet
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet ' This could be always the same sheet. If so, replace activesheet with thisworkbook.Sheets("NameOfTheSheet")
' Insert a new column for numerical sequence
targetSheet.Columns("A:A").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Delete all blank rows
Dim counter As Long
With targetSheet
For counter = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(.Rows(counter)) = 0 Then
.Rows(counter).Delete
End If
Next counter
End With
' Add two new columns for population (this next lines would make column B empty, so filling sequentally would not work below
'targetSheet.Columns("D:D").Delete shift:=xlToLeft
'targetSheet.Columns("A:B").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'targetSheet.Columns("A:B").CurrentRegion.NumberFormat = "#" -> commented this line because cells are going to be empty. What do you want to format as text? maybe this could go after you add the numbers. Also formatting the whole column is a waste of resources
' Insert a number starting at 1 in column A1 (added number 2 to fill down in sequence)
targetSheet.Range("A1").Value = 1
targetSheet.Range("A2").Value = 2
' Sequentially fill in until all rows with records have a number (this doesn't take into account if there are gaps in column b)
Dim referenceRange As Range
Set referenceRange = targetSheet.Range("B1:B" & targetSheet.Range("B" & targetSheet.Rows.Count).End(xlUp).Row)
targetSheet.Range("A1:A2").AutoFill Destination:=referenceRange.Offset(0, -1)
End Sub
Let me know if it works
PS. Check Sidar's answer on how to properly delete empty rows: https://stackoverflow.com/a/9379968/1521579
Could you try this?
'code to enter a sequential number starting at 1 for every row that has a record
'remove your code from here on and substitute with the following
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
ActiveSheet.Range("A1").Select
With ActiveCell
.FormulaR1C1 = "1"
.AutoFill Destination:=ActiveCell.Range("A1:A" & LastRow), Type:=xlFillSeries
End With
I’m trying to create VBA that allows me to copy the one of a cell and paste over until end of the row in the same column.
But I’m unable to figure out how this works, I have a total of 109 rows with 20 columns and in column “BD” that is an empty column and I want to put today date and fill up rest of the same column until end of row.
Please see the code at the bottom
Sub CopyInsert()
Range("BD2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("BD2").Select
Selection.Copy
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveSheet.Paste
End Sub
This code is working fine but I’m not getting the right result what these codes do is copy and paste over pass 109 rows mean is paste over up to around 2000 rows
My question is how can I copy and paste over until the end of the row like till row 109! If we have over 200 rows, how to copy and paste until end of the row, row 200 in one column! But not using (BD2:BD), I have tried (BD2:BD) and is paste over 109 rows is not stopped at the end of row.
many thanks.
So you need to find the lastRow based on the column where the actual data is...
Try something like this:
With worksheets("mySheet")
Dim lastRow as Long
lastRow = .Cells(.Rows.Count,1).End(xlUp).Row 'this uses column A for example
.Range("BD2:BD" & lastRow).Formula = "=TODAY()"
End With
Good afternoon,
After too many hours of researching the proper code for what I am trying to do, I am finally having to ask the experts here. I am terribly new to VBA (but now hooked on conquering it!).
I am trying to copy a range of 3 cells of data I enter daily (I enter the data into columns J:L), then paste it 7 times, every 7th row below (so, I am copy/pasting Monday data to the next 7 Mondays, in their respective rows below). Each day changes, and so will the paste location (Tuesday data will be copied, then pasted to the next 7 Tuesday rows below, etc.). The data I enter will always be columns J:L.
Then, once the data is pasted, I have a button in place that uses that data, and clears it. So, columns J:L are always clear, until I add the data to the next row of 3 cells.
Any help is appreciated, as I am simply stumped. I tried several variations of "lastrow", but haven't found the proper coding that works for me (from piecing together info from here, but failing to make it work).
I tried to add a snapshot here, but apparently, I'm too noob for that even :/
The idea seems simple, so hopefully there will be a simple solution.
Thank you for your awesomeness!
Edited (sorry for making my first run at this site so difficult :/ )
Sub CopyPaste()
'
' CopyPaste Macro
' copies and pastes range for 8 total weeks
'
Dim lastrow As Long
lastrow = Range("J" & Rows.Count).End(xlUp).Row
'
Selection.Copy
Range("J27").Select
ActiveSheet.Paste
Range("J34").Select
ActiveSheet.Paste
Range("J41").Select
ActiveSheet.Paste
Range("J48").Select
ActiveSheet.Paste
Range("J55").Select
ActiveSheet.Paste
Range("J62").Select
ActiveSheet.Paste
Range("J69").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
See if this helps. I foresee a problem though in that once you have copied values down the worksheet for say Monday, the last used row will be row 70 or something like that.
Sub x()
Dim i As Long, lastrow As Long
lastrow = Range("J" & Rows.Count).End(xlUp).Row
For i = 1 To 7
Cells(lastrow, "J").Resize(, 3).Offset(7 * i).Value = Cells(lastrow, "J").Resize(, 3).Value
Next i
End Sub
I recorded a macro, it filters a sheet, copies the filtered data and pastes it into another workbook. It worked the first few times I used it, now it gives me an error:
Run-time 1004 - We can't Paste because the Copy area and Paste area
aren't the same size.
Nothing changed, it just now flags the error on the "ActiveSheet.Paste" line. Can anyone explain why it does this out of nowhere randomly? I know tomorrow when I try again it will work fine for a few uses then do this again. I looked online it seems to be a common issue, I haven't found a solution that has worked for me yet, does anyone have an idea? Or is there another way to do this maybe so I can just avoid it?
The code:
Sub Macro201()
ActiveSheet.Range("$A$6:$H$55").AutoFilter Field:=8, Criteria1:="99"
Range("A7:B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoiceTEST.xls").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
End Sub
First of all, you don't need to select anything. For example, Range("A7:B7") is a range. Selection is also a range (in this context). So, you assign the range to a Selection.Range and then use the Selection.Range. Why not use the Range you defined at the outset?
Next, you do have to specify the Worksheet you are working on, especially the one in the target workbook.
Finally, you must clearly identify the last rows you use. Your formula picks the last row in the sheets you work with, not the last used row. So you are throwing around millions of blank cells.
Put all of the above together and you arrive a code like the following.
Sub CopyData()
' 01 May 2017
Dim Rng As Range
With ActiveSheet
Set Rng = .Range("$A$6:$H$55")
Rng.AutoFilter Field:=8, Criteria1:="99"
If Application.WorksheetFunction.Subtotal(3, Rng) = 0 Then Exit Sub
.Range("A7:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy
End With
With Workbooks("invoiceTEST.xls").Sheets(1)
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
End With
End Sub
Note that the code will fail if the target workbook isn't open when you attempt to run it.
I'm fairly new to coding so I'll be brief. I have a very large dataset to process in excel. From two spreadsheets, I've pooled data together.
So each set has 4 columns. One column contains the alphanumeric names for a datapoint. (Example, NC000023, NC000224, etc.). I want to line up the matching alphanumeric names with one sheet to another. The first thing that came to mind was to SORT both columns alphabetically, which did match most up. However, there are some datapoints missing from one sheet to another, causing several frameshifs throughout the data.
I have written the following macros for correcting these frameshifts.
The first is just to determine if the two columns match in a particular row
Sub Matching()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+m
'
Range("I2").Select
ActiveCell.FormulaR1C1 = "=EXACT(RC[-4],RC[-5])"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I40028"), Type:=xlFillDefault
This brings up a new column with TRUE of FALSE depending on whether or not D3 mathes E3, and D550 matches D550 and so forth.
I then seek out any cells in the I column with FALSE, and determine which 4 cells I need to delete in order to correct that matching. The code was designed to cut out the culprit, paste it out of the way, and move the lower rows up to take its place.
Sub RedCut()
'
' Macro2 Macro
' Shortcut CTRL + r
'
ActiveCell.Offset([0], [-3]).Select
Range(ActiveCell, ActiveCell.Offset(0, 3)).Cut
ActiveCell.Offset([0], [12]).Select
ActiveSheet.Paste
ActiveCell.Offset([0], [-12]).Select
Range(ActiveCell, ActiveCell.Offset(0, 3)).Select
Selection.Delete Shift:=xlUp
End Sub
And for the other
Sub Bluecut()
'
' Bluecut Macro
'
' Keyboard Shortcut: Ctrl+b
ActiveCell.Offset([0], [3]).Select
Range(ActiveCell, ActiveCell.Offset(0, -3)).Cut
ActiveCell.Offset([0], [9]).Select
ActiveSheet.Paste
ActiveCell.Offset([0], [-9]).Select
Range(ActiveCell, ActiveCell.Offset(0, -3)).Select
Selection.Delete Shift:=xlUp
'
End Sub
With these Macros written, I've been carying out the following steps.
Hit CTRL+ M to call up the list of TRUE or FALSE for the title rows matching up
Seek out a row with FALSE. Determine if it is four cells from dataset 1 or dataset 2 that needs to be removed
Hit CTRL + M again, and have that row corrected.
My question is, is it possible to write a code that says "Perform Sub Bluecut for a row with FALSE in column I if the corresponding cell in column D is identical to one cell down and to the left, or Perform Sub Redcut for a row with FALSE in column if the corresponding cell in column D is identical to one cell up and to the right."
Sorry, this seemed a lot less complicated to explain when I started typing. I'd appreciate ANY help you can give me, even if it is a tip to writing even a tiny piece of this code.
Thanks in advance.
a for/next or for/each loop should suit your needs.
as a quick throw together, I would do something like this, to run after your matching:
Dim I as range
for each I in Range("I2:I40028").Cells
I.select
if activecell.offset(0,-5)=activecell(1,-6) then
bluecut
else
redcut
end if
next
of course, I would do all the testing internally, rather than selecting each cell, as it would run a lot faster, even with application.ScreenUpdating=False to stop having to view all the screen updates