I have a spreadsheet where I am inserting rows and copy pasting data (in any row of 1st column) using AutoFill in macro. In macro - Seven-Day, it works fine on other rows but NOT in case if data is in first row and first row has white background. Please guide.
Here is code:
Sub Macro7Day()
If ActiveCell.Column = 1 Then
Dim numCopies As Long
numCopies = 6
Dim i As Long
For i = 1 To numCopies
Rows(ActiveCell.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
Range("A5:E5").Copy
Range(ActiveCell, ActiveCell.Offset(numCopies, 4)).PasteSpecial xlPasteFormats
ActiveCell.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(numCopies, 0)), Type:=xlFillDefault 'xlFillCopy
End If
End Sub
Based on my test, your code run well on copying insert data with formatting in any row of 1st column.
However, as you described it, your code works fine on other rows but NOT in case if data is in first row and first row has white background.
I'm wondering that what does "first row has white background" mean or there is no data in first row ?
Hope you updates for this.
Thanks,
Yuki
Related
So my code is to insert a row, copy its format from the previous row, and then insert the formulas that I have preset on a different row. So lets say I insert a new row, row 11, the formula should copy row 10's formats and insert the formulas from row 44 (which I designated as my formula row).
Now, the formulas will all reference row 10 instead of row 11. I'm not sure why that is.
Here is my code:
Dim i As Integer
'loop through position sheets and insert blank rows
For i = 1 To 4
Sheets(i).Select
Rows(row_to_insert).EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
'loop through sheets and copy/paste formulas into new rows
For i = 1 To 4
Sheets(i).Select
Rows(blank_row_to_use + 1).EntireRow.Select
Selection.Copy
Rows(row_to_insert).EntireRow.Select
ActiveSheet.Paste
Next I
End Sub
This worked fine until I added a new sheet, and expanded from For i = 1 To 3 to For i = 1 to 4.
Any ideas why it suddenly stopped working?
the issue lays in those relative references to another sheet that don't get updated by any rows shifts taking place in the sheet where they are used
while they'd get updated if you shifted rows in the sheet they are referencing
so you have to play a little bit with relative /absolute references to mimic some referenced sheet rows shifting, but without doing it!
for instance you could use a Function that converts some range formulas to absolute or relative reference type, like the following:
Sub Convert(rng As Range, toReferenceType As XlReferenceType)
Dim cell As Range
For Each cell In rng.SpecialCells(XlCellType.xlCellTypeFormulas) ' loop thorugh passed range relevant cells (i.e. those containing formulas)
If InStr(cell.Formula, "!") > 0 Then cell.Formula = Application.ConvertFormula(cell.Formula, xlA1, xlA1, toReferenceType) ' if current cell has an explicit sheet reference, then convert its formula to the passed reference type
Next
End Sub
and the use it in your code
For i = 1 To 1
With ThisWorkbook.Sheets(i)
.Rows(blank_row_to_use).Copy .Rows(blank_row_to_use + 1) ' copy formulas "template" row one "helper" row below
Convert .Rows(blank_row_to_use + 1), xlAbsolute ' convert "helper" row formulas with some explicit sheet reference to absolute type so they don't get updated by any subsequent row shift
.Rows(blank_row_to_use + 1).Copy .Rows(blank_row_to_use) ' copy "helper" row converted formulas and paste them back to formula "template" row -> now you have a formula with an absolute row reference one below its own row
.Rows(blank_row_to_use + 1).ClearContents ' clear "helper" row
.Rows(row_to_insert).Insert Shift:=xlDown, opyOrigin:=xlFormatFromLeftOrAbove ' insert new row -> formulas "template" row references don't get updated and now you have a formula with an absolute row reference to its own row
Convert .Rows(blank_row_to_use + 1), xlRelative ' convert formulas "template" row formulas with some explicit sheet reference to relative type so they do get updated by any subsequent row shift
.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula ' copy formulas "template" row formulas row to the new row and have them updated
End With
Next
Please note also that
.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula
is better than any Copy and subsequent PasteSpecial approach in that it doesn't use the clipboard
Try the much shorter and cleaner version of what you are trying to achieve.
Note: try to avoid using Select, Selection and ActiveSheet, and use fully qualified Sheet objects.
Modified Code
'loop through position sheets and insert blank rows
For i = 1 To 4
With ThisWorkbook.Sheets(i)
.Rows(row_to_insert).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(blank_row_to_use + 1).EntireRow.Copy
.Rows(row_to_insert).EntireRow.PasteSpecial xlPasteFormulas
End With
Next i
Somewhat new to VBA excel. I've spent a good 4 days trying to figure this out and playing around with the code and I'm finally reaching out for help.
The gist of what I'm trying to do is use a button that when clicked it takes data that has already been generated and sits in cell L11. The way the data is supposed to flow is by day in a month. When data is entered in L11, the day changes each entry. So when I push the button, I'd like the code to say - based on the day (already generated) in cell L8, take the data in L11 and cut and paste it under Sheet2 and column for that date.
I've built the following code that moves the data from L11 to sheet 2 cell A2 and then add the data to the next line on sheet2 if data already exists, but to make what I'm trying to do even faster, I'd like to have the code know what date is in L8 and find that date in a column on sheet2 and paste it under that date while removing the copied data from sheet1:
Sub copypastetosheets2()
For Each cell In Range("L8:L8")
If cell.Value = "Monday, April 15" Then
Range("L11:L11").Select
Selection.Copy
Sheets("sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("sheet1").Select
Range("L11").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
Range("A2").Select
Selection.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
Sheets("sheet1").Select
Range("L11").Select
I've also used this code on a different button which works and does what I'd like it to do, but it still doesn't recognize the date and to put it in a different column:
Sub copypastetosheets()
Sheets("sheet1").Range("L11").Copy
With Sheets("April 15").Range("A" & Rows.Count).End(xlUp).Offset(1)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
Worksheets("sheet1").Range("L11:L20").ClearContents
End With
End Sub
Don't mind the Sheets("April 15").... I was using that while I was testing. This code works well, but the only thing holding me back is the recognition of the date. If it knew to look at the date as changing variable and then based on that specific date pasted the data from L11 on Sheet1 under 1 of the 30 or 31 columns in accordance to that date, I'd be done for now :)
Any help or guidance is greatly appreciated. Thank you.
Dave
Ok, Given what you have told me, here is a pretty basic method, for the dates, use Month day. For example L8 = April 3.
Sheet2
April 1 April 2 April 3 April 4 April 5 ...
Data is
copied
here
I hope I understand you properly. this will find the matching date in sheet2, copy the data over and delete the data in L8.
Option Explicit
Dim x As Integer
Sub Button1_Click()
x = 1
'this will find the column that matches the date and stores that as the copy location.
While Sheets("Sheet2").Cells(1, x).Value <> Sheets("Sheet1").Range("L8")
x = x + 1
Wend
'this portion copies the data to the designated coordinates found by the first portion and delete the information from L8 and L11.
Sheets("Sheet2").Cells(2, x).Value = Sheets("Sheet1").Range("L11").Value
Sheets("Sheet1").Range("L8").Value = ""
End Sub
Because L11 has a formula in it, you don't want to delete the cell. Change the formula in it to be this: =IF(L8 <> "", VLOOKUP(K8,A28:B58,2,FALSE), "")
This formula will make L11 appear blank as long as L8 has no data in it.
I'm trying to make a code that checks for numbers in a master sheet called All in column D (ex. 780101) and if it meets the criteria, it copies the whole row and inserts (not paste) it to another sheet with the name of the criteria (ex. 780101), starting on row 6.
The code I have doesn't work like I want it to. It doesn't copy all the rows that meet the criteria and sometimes it inserts blank rows.
Sub Insert()
For Each Cell In Sheets("All").Range("D:D")
If Cell.Value = "780101" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow + 1).Select
Selection.Copy
Sheets("780101").Select
Rows("6:6").Select
Selection.Insert Shift:=xlDown
End If
Next
End Sub
I'm just starting to learn VBA, so if it could be possible the names of the sheets would be the criteria of the cell values (the code is made for only one sheet - 780101, but there are 20 of sheets with different names).
It's tough to make recommendations without seeing sample data and what could potentially be causing the problems you are having but you can run this rehash of your existing code.
Sub Insert()
Dim dc As Range
With Sheets("All")
For Each dc In Intersect(.Range("D:D"), .UsedRange)
If dc.Value2 = 780101 Then
dc.Resize(2, 1).EntireRow.Copy
Sheets("780101").Rows(6).Insert Shift:=xlDown
End If
Next
End With
End Sub
The nature of running that from top to bottom means that the results will be reversed. You may wish to consider running the main loop from bottom to top to maintain the order.
I have a project on excel macro, I need to highlight the next last row that has an empty value. example cell A1:A100 have data and the next cell is A101 is empty.
when user click a button it should highlight the cell A101...
If you are certain that you only need column A, then you can use an End function in VBA to get that result.
If all the cells A1:A100 are filled, then to select the next empty cell use:
Range("A1").End(xlDown).Offset(1, 0).Select
Here, End(xlDown) is the equivalent of selecting A1 and pressing Ctrl + Down Arrow.
If there are blank cells in A1:A100, then you need to start at the bottom and work your way up. You can do this by combining the use of Rows.Count and End(xlUp), like so:
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Going on even further, this can be generalized to selecting a range of cells, starting at a point of your choice (not just in column A). In the following code, assume you have values in cells C10:C100, with blank cells interspersed in between. You wish to select all the cells C10:C100, not knowing that the column ends at row 100, starting by manually selecting C10.
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlUp)).Select
The above line is perhaps one of the more important lines to know as a VBA programmer, as it allows you to dynamically select ranges based on very few criteria, and not be bothered with blank cells in the middle.
try this:
Sub test()
With Application.WorksheetFunction
Cells(.CountA(Columns("A:A")) + 1, 1).Select
End With
End Sub
Hope this works for you.
This does it:
Do
c = c + 1
Loop While Cells(c, "A").Value <> ""
'prints the last empty row
Debug.Print c
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