I have the following macro defined which inserts rows into a sheet. After the rows are inserted at specified start addresses, the various ranges are then converted into Tables. My initial thoughts are that the issue lies with the use of xlDown - since this is the place in code where rows are inserted.
At present I have 7 such ranges, however the issue is that first three always have an additional row inserted - this was previously working with no issues, so the fact that its misbehaving is a puzzle to me.
The remaining ranges are correct. The tableStartAdress refers to named ranges whose values correspond to the first cell below the green title, ie A4, A12 etc. rowsToInsert for this example is always 38.
Sub InsertTableRows(tableStartAdress As String, rowsToInsert As Integer)
Dim i As Integer
Dim rowToCopy As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayAlerts = False
Range(tableStartAdress).Offset(1, 0).Rows.Copy
rowToCopy = Range(tableStartAdress).Offset(1, 0).row & ":" & _
Range(tableStartAdress).Offset(1, 0).row
Rows(rowToCopy).Select
Selection.Copy
Range(tableStartAdress).Offset(1, 0).Select
ActiveCell.Resize(rowsToInsert, 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The following pictures depict what I mean.
Before:
.
Once data is populated the first three range/tables have an extra row
, ,
Whilst the remainder are correct
I'd suggest simplifying your code to start. (Might help you track down were things are going wrong.) Since you don't need to select a range before you do something with it....
rowToCopy = Range(tableStartAdress).Offset(1, 0).Row & _
":" & Range(tableStartAdress).Offset(1, 0).Row
Rows(rowToCopy).Select
Selection.Copy
Range(tableStartAdress).Offset(1, 0).Select
ActiveCell.Resize(rowsToInsert, 1).Select
Selection.Insert Shift:=xlDown
is the same as...
Range(tableStartAdress).Offset(1, 0).EntireRow.Copy
Range(tableStartAdress).Offset(1, 0).Resize(rowsToInsert, 1).Insert Shift:=xlDown
which is much easier to look at. A couple thoughts: First, are you sure that tableStartAddress is really always a single cell (and the correct cell)? Are you sure that rowsToInsert is always 38? Beyond that, your code as it's currently written is copying an entire row and inserting it into a range that's theoretically 38 rows by 1 column. I would recommend rewriting this so you first insert however many rows you want, then fill the 38 x 1 range with the data that belongs there.
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 fairly new to VBA and i'm struggling to figure out code to copy and paste certain values to a different worksheet
I've got some code that does work, however it is very slow to run:
If CheckBox1.Value = True Then Sheets("Sheet1").Range("A2:B2").Copy Destination:=Sheets("Sheet2").Range("A2:B2")
If CheckBox2.Value = True Then Sheets("Sheet1").Range("A3:B3").Copy Destination:=Sheets("Sheet2").Range("A3:B3")
If CheckBox3.Value = True Then Sheets("Sheet1").Range("A4:B4").Copy Destination:=Sheets("Sheet2").Range("A4:B4")
...............
If CheckBox53.Value = True Then Sheets("Sheet1").Range("A54:B54").Copy Destination:=Sheets("Sheet2").Range("A54:B54")
I've got each checkbox linked to the cell next to it, e.g E2, E3, E4 etc to display True/False depending on whether is been clicked or not. Also
I'm thinking that a for loop would be better,e.g for "a=2 to 53" and use the true/false values in column E, however i'm unsure how to modify the range of cells within a for loop so that it increases just like "a", so A2:B2, A3:B3 etc
Also, the other problem with this code is that is copies the values to the same cells within the 2nd sheet. What would be the best way to get it to paste the values to the next available row.
If anyone could point out somewhere there's some similar example code that would be extremely useful so that i can learn how to do it myself.
Kind regards
Chris
edit with working code
This is the code that i've come up with to fulfill the criteria outlined above
Sub checkbox()
For i = 2 To 53
Sheets("Sheet1").Select 'activates sheet 1
If Sheets("sheet1").Cells(i, "E").Value = True Then ' checks for true value
Range("A" & i & ":B" & i).Select 'selects range of cells for copying
Selection.Copy
Sheets("Sheet2").Select 'selects sheet 2
Range("A65536").End(xlUp).Offset(1, 0).Select 'selects next available empty row
ActiveSheet.Paste 'pastes value
Else
End If
Next i
End Sub
Dim lastrow&, lastCol&, myarray As Range
lastrow = Range("A1").End(xlDown).Row
lastCol = Range("XX1").End(xlToLeft).Column
Set myarray = Range("A1").Resize(lastrow, lastCol)
Range("A1", myarray).Select
Selection.Copy
So basically, i am trying to get select an array which could vary, I know it starts at A1, but I'm unsure which row and column it will end at. Code above works fine to help copy this array.
Application.CutCopyMode = False
Selection.Copy
Application.WindowState = xlNormal
Windows("macrofile.xlsm").Activate
Sheets("MRG").Select
'has to find the last row by itself
Range("A" & Rows.Count).End(xlUp).Offset(2, 0).Select
ActiveCell.PasteSpecial (xlPasteAll)
I am getting an error on the last line ActiveCell.PasteSpecial (xlPasteAll).
Error 1004, can't paste because copy area and paste area aren't the same
I have tried different variations including activesheet.paste and xlpastevalues to no avail.
Range("A" & Rows.Count).End(xlUp).Offset(2, 0).Select selects a single cell in column A to find the last used row and offsets it by 2 rows so I can paste below the existing data. Not sure why error 1004 comes up because replicating selecting an array and pasting it into a single cell in excel runs no errors.
Any help is much appreciated; I am really new to VBA and most of this code came from different sources online.
As long as the source data has no blank rows or columns you can do this:
ActiveSheet.Range("A1").Currentregion.Copy _
Workbooks("macrofile.xlsm").Sheets("MRG").Cells(Rows.Count, "A").End(xlUp).Offset(2,0)
Assuming there's room for the pasted data.
I am trying to delete entire rows with duplicate values. If the values in column "E" are the same in two rows, I want to delete all row with that value that is duplicated.
The other fields might be or not duplicates of that row and there might be up to ten duplicates and the total number of rows is large ( #rows >4000). This is just one part of a large macro, so I cannot use excel functions. This is what I have so far for deleting rows:
Sub AAAAH()
Application.ScreenUpdating = False
Dim i As Single
Dim j As Single
BottomLineRelease = Sheets("Hours Of Interest").Range("E" & Rows.Count).End(xlUp).Row + 1
rowcount = Sheets("Hours Of Interest").Range("E2:E" & BottomLineRelease).Rows.Count
For i = 2 To Sheets("Hours Of Interest").Cells(Rows.Count, "E").End(xlUp).Row
If Sheets("Hours Of Interest").Range("E" & i) = Sheets("Hours Of Interest").Range("E" & i - 1) Then
j = i - 1
Rows(j).Select
Selection.delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub
This not only crashes Excel, but the "Selection.delete Shift: =xlup" will not allow the "delete" to stay capitalized. Every time I click away, it goes back to lower case.
Does anyone know a faster or at least functional way to delete these duplicate rows in VBA?
Selection (=Application.Selection) is declared only as Object because it can take various objects (a range, a shape object, a chart etc. etc.). Therefore the intellisense doesn't work as well, it is only determined during execution if .Delete is a valid method.
Try
Sheets("Hours Of Interest").Rows(j).Delete Shift:=xlUp
If you use Sheets(...).Range in your code, you should never get lazy and never use Range or Rows or Cells without that explicit reference, you might be deleting on a different worksheet.
Furthermore, if you delete rows from the top down, every delete changes the row numbers of the following lines.
So you should delete backwars with
for i = [..maximum..] to 0 step -1
You don't need a loop to isolate unique values. You can filter column E for unique values, copy those to a new sheet, and delete the old sheet.
lastRow = Range("A1000000").End(xlUp).Row
Range("A1:H" & lastRow).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("E1:E" & lastRow), Unique:=True
Cells.Copy
Sheets.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
Sheets("oldSheet").Delete
Application.DisplayAlerts = True
This is way faster than a loop, if memory serves.
I couldn't really figure out how to title this, but here's a bit more in depth description. I have created a VBA code which will filter an excel file based on certain Criteria, and then whatever "matches" that Criteria will be renamed in cell A (Whatever row it is) and my macro goes to the end of the Criteria and then to the left, and will change it to whatever it needs to be renamed to and then copy and paste all the way above.
The problem: As of right now, if there is nothing that fits that criteria the code makes my cursor or whatever go all the way to the bottom of the document and pastes the rename from the bottom of the spreadsheet alll the way to the top. This is obviously a big problem, that I feel has a simple solution.
Here is my code. Thanks in advance, this forum is awesome.
Update: I have also attached an example excel sheet which if you run through this code (F8 all the way through), you'll be able to see where and how the error occurs. Thanks in advance guys.
Here is the link to download my file (Dropbox): https://www.dropbox.com/s/bx4ogcsdbmmzs59/ExcelExample11.xlsm?m
UPDATE: I have currently edited the code to this: And most of the time it will not go to Else...why does it continue when the cell below the header column contains nothing? I'm very confused.
Range("M1").Select
ActiveSheet.Range(Selection, Selection.End(xlUp)).AutoFilter Field:=13, Criteria1:="=BCC*"
If Not Selection.Offset(0, 1) = "" Then
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.FormulaR1C1 = "CLO"
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "'Subtype"
Else
ActiveSheet.ShowAllData
Range("A1").Select
ActiveSheet.Range(Selection, Selection.End(xlUp)).AutoFilter Field:=1, Criteria1:="#N/A"
End If
I can't download your code right now, but I am 99% sure you can fix the problem by taking a look at these two statements:
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
When the filter returns nothing, the second of these will take you all the way to the bottom of the spreadsheet. So right after this statement you need to test the row number - if your row number is greater than the rows used, you have "run off the end".
To start with you need to know what the last "valid row" in your spreadsheet is. Somewhere in your module (or in a new one) define a function lastRowUsed like this (note - you can't just use ActiveSheet.UsedRange.Rows.Count since that will return a number < last row if the first rows are blank. If that's never the case for you, you can simplify your life a little bit):
Option Explicit
Function lastRowUsed()
' returns last row used on Active Sheet
Dim address As String
Dim lastRow As String
Dim ii As Integer
' address of range has form $A$2:$C$10
address = ActiveSheet.UsedRange.address
lastRow = ""
' start at the end and work back until you find a "$"
For ii = Len(address) To 1 Step -1
If Mid(address, ii, 1) = "$" Then Exit For
lastRow = Mid(address, ii, 1) + lastRow
Next ii
lastRowUsed = Val(lastRow)
End Function
Once you have this function defined you can test whether you fell off the edge (right after the Selection.End(xlDown).Select above) with a simple
if Selection.Row > lastRowUsed Then Goto NothingFound
And at the bottom of your code you create a label
NothingFound:
' code you run when you had "nothing found"
Here you handle the case you wanted to trap.