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
I have an excel sheet with multiple ranges one below the other. The range is only one row with multiple formulas. The formulas would need to be replicated below that row. I would need to resize each one of them with a loop. However as there are multiple ones the End function doesn't work.
For i = 1 To 2
resizeSh.Range("tablename").EntireRow.Copy
Destination:=resizeSh.Range("tablename").End(xlUp).Offset(1, 0)
Next
Does anyone have a solution how to find the last row of the named range and insert the same formulas few times again?
I also tried with this, but it instead of 2 it adds 3 additional lines and I cannot find the cause of this:
For i = 1 To 2
ActiveSheet.Range("range").Cells(1, 1).Offset(1).EntireRow.Insert
Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveSheet.Range("range").Cells(1, 1).EntireRow.Copy
ActiveSheet.Range("range").Cells(1, 1).Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Next
I'm not sure I follow what you're trying to do, but this might help.
With Range("range")
.Copy
.Offset(1).Resize(3).Insert shift:=xlDown
End With
Every quarter I need to input the amount of each product we have and then compare this to the previous quarter.
I need to be able to see the past 4 quarters. However, anything beyond the last 4 quarters must be kept (but not visible). So far, I've done this by grouping them. This means that if someone wants to see all of the information, they can. The most recent quarter also needs to be formatted differently to the rest (see images below).
To keep things simple, below is a very basic example of what I'm looking for.
https://i.stack.imgur.com/bGdyA.png
So far, this is what I've got. However, this doesn't work perfectly because once it inserts the new column, all of the columns referenced are no longer correct:
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:C").Select
Selection.Copy
Columns("C:C").Select
ActiveSheet.Paste
Columns("D:D").Select
Selection.AutoFill Destination:=Columns("C:D"), Type:=xlFillFormats
Columns("B:B").Select
Selection.ClearContents
Range("B1").Select
ActiveCell.FormulaR1C1 = "Q2_18"
Range("L1").Select
ActiveCell.FormulaR1C1 = "=RC[-10]"
Range("U1").Select
ActiveCell.FormulaR1C1 = "=RC[-19]"
Columns("G:H").Select
Selection.Columns.Ungroup
Columns("F:H").Select
Selection.Columns.Group
The main problem seems to be with the insert. In this example, I need to insert a new column before D, N and W. However, after inserting the column before column D, column N then becomes O and column W becomes X. I need to code this in a way that the insert does not have a knock on affect to the rest of the changes but I'm not sure if this is possible?
It can take the best part of an hour to format all of the tables and that's before even looking at any of the figures. Therefore, any help would be greatly appreciated!
Example of deletion in a loop, which should make more sense than just seeing other items inserted in individual lines of code (untested, top of head code)
Dim i as long, lr as long
lr = cells(rows.count,1).end(xlup).row 'dynamic last row
For i = lr to 2 Step -2 'each loop goes BACKWARDS by counts of 2
Rows(i).delete 'every other row, from the last row until 2 is deleted
Next i
Had I put the above code to read For i = 2 to lr Step 1, it would increase the row number 1 for every deletion, meaning that i would first delete row 2 (makes old row 4 now row 3), then deletes old row 5 (in the 4 position), etc.
Similar if you do this for insert, you would push the other rows further down, so each insert would be in the incorrect place.
Introduction
I have some spreadsheets like the following.
Here the header is on rows 16 and 17. There is a "header" to the left (not shown) among the earlier rows and columns that includes a picture, some non-tabular data, a legend, etc., that is unimportant here. Header text on row 16 is obfuscated because reasons. Data marked in bold red indicates that that sample point has undergone some process. Here is the code snippet from the script that highlights those data points in bold red.
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
Selection.AutoFilter ' Turn on autofiltering (hopefully)
Selection.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e"
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Selection.AutoFilter ' Turn off autofiltering
Columns(ColumnLetter(currIndex + 1) & ":" & ColumnLetter(currIndex + 1)).EntireColumn.Delete Shift:=xlToLeft
End If
End If
Next currIndex
Context
Here, abcDateCol refers to column AE, lastCol refers to column AQ, abcDateRow (not shown, but available) and abcDateRowDesc refer to the header rows 16 and 17 respectively, and the ColumnLetter function is a user-defined function that returns the human-readable column letter(s) given a column number; this is common functionality you may have seen elsewhere, or even made yourself.
Let's Continue
Never mind that the condition in If Cells(abcDateRowDesc, currIndex).Value() = "Comments" is never satisfied because of an oversight (I'm assuming) -- two different rows, guaranteed.
Let's take a look at what the spreadsheet looks like before this script is executed.
So, the script takes pairs of columns, and for each pair of columns it marks data cells bold red if a data cell's right-adjacent cell has a 1 (or an "e"?) (as a boolean; answers the question, "Has this sample point undergone whatever process?") and then trashes the "process" column.
The Problem
A client wants the gratuitous header gone, so they may more easily import the spreadsheet into whatever solution they have. Delete rows 1 through 15, and this is what I get.
What in the bleepity-bleep happened to the header? I don't understand how this first row gets highlighted. It seems too perfectly weird. Now, let's revisit the very first spreadsheet.
I've filled the "header" with some dummy text after the script executed. Wow, there's the first row reddened again, this time ad infinitum! So, this problem has always existed. Oh, and the first column, too! And, it magically stops right above the proper header so we would never see it.
The Questions
Why is this script unexpectedly reddening the first row and column? Can this be easily solved, or am I looking at some sort of a rewrite? If so, please point me in the general direction.
It helps to mention that these spreadsheets are generated from a Windows application and their scripts executed before a user has a copy of their spreadsheet. Also, regarding the second picture (the spreadsheet with the "process" columns shown), this spreadsheet is not something that normally exists. I generated it for the sake of this post by skipping the script's for loop. The application uses a chosen spreadsheet template, that looks the same minus the data, fills in the sample data, and then executes several scripts over the data.
I considered using conditional formatting, but there are a few dozen spreadsheet templates. Even if I just change the one I need, I can't change the fact that these common scripts run over it. I feel my best option is to correct the script. And, I wouldn't change the script to account for my edge case. The whole ecosystem feels flaky, but that's just subjective.
Note
I am not the author of this script (or any of my company's VBA!). I'm considering this an inheritance tax levied upon me.
*Update
I was asked if I traced through this code. I apologize that I didn't include that information in my original post. Here is what I know. Selection.Font.ColorIndex = 3 turns the cells in the selection that satisfy the autofilter plus the first row (two cells as only two columns are selected at a given time), and Selection.Font.Bold = True makes the same cells bold in the same manner. I suspect it has something to do with the autofilter, so I'm going to take a look at the answers now.
This edit should fix your problems, hopefully (they did for my remake of your spreadsheet, but we won't know til you try on the real thing)
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
'Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
With Range(Cells(abcDateRowDesc, currIndex), Cells(abcDateRowDesc, currIndex + 1).End(xlDown))
.AutoFilter 2, "=1", xlOr, "=e"
' Don't format header
With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) .Font.ColorIndex = 3
.Font.Bold = True
.AutoFilter ' Turn off autofiltering
End With
End With
Columns(currIndex + 1).Delete xlShiftLeft
End If
End If
Next currIndex
This all starts with a quirk of how the code is choosing its range to autofilter. The selected area is the full column, instead of the area you actually want to format (row 18 to the last entry). It seems that autofiltering on a full column with empty top rows automatically sets the first nonempty row as the header row. So the header is left unfiltered/unhidden by the statement, and it gets colored in as part of the full column selection. So that's why your headers are getting colored.
Now, if you tried to test this by putting data in the above empty rows like "a", those values would become the first ones in the column and would be selected as the headers - meaning those values get colored. Whatever is in the first nonempty row of your columns will be the autofilter header and will get colored.
But that should only affect the columns you explicitly colored, not the entirety of the first row, right? The problem here is that Excel likes to make assumptions about data in order to save time. So if you have a whole row full of red, bold "a"'s and right next to them you put in another "a" to test whether that cell is formatted or not... well, it automatically gives you a red, bold "a" despite the cell being previously unformatted! And if you keep going down the row in this way, it'll appear like your whole row got formatted. But, if you were to jump over a few columns (say, 5-ish) and enter in another "a", voila, it's unformatted, and any "a"s you put in near it will be too. You can also check what Excel by deleting an unformatted "a" in a far off column, then continuing to enter "a"'s all the way down until you reach that same cell - this time, the "a" will be red and bold because all of the others in the row were, too, even though we just checked that this was an unformatted cell!
Basically, having the wrong range for your autofilter made things act very unexpectedly, then trying to test the formatting issue by entering in values just made everything less clear. The code I've provided just autofilters the relevant area (row 17 to the last contiguous row), fixing the core issue.
here's a (commented) refactoring of your code that should do:
Option Explicit
Sub main()
Dim abcDateCol As Long, lastCol As Long, abcDateRow As Long, abcDateRowDesc As Long, currIndex As Long
abcDateCol = 31
lastCol = 43
abcDateRow = 16 '<--| you can change it to 1 for the last "scenario"
abcDateRowDesc = 17 '<--| you can change it to 2 for the last "scenario"
For currIndex = abcDateCol + 1 To lastCol '<--| loop through columns
With Cells(abcDateRow, currIndex) '<--| refer to cell in current column on row abcDateRow
If .Value = "Comments" Then Exit For '<--| Check for exit conditions on row 'abcDateRow'
If .Offset(1).Value <> "" And .Offset(1, 1).Value = "process" Then '<--| Check for processing conditions on row 'abcDateRowDesc'
With .Resize(.Offset(, 1).End(xlDown).Row - .Row + 1, 2) '<-- consider the range from current referenced cell 1 column to the right and down to last 'process' number/letter
.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e" '<--| filter on "process" field with "1" or "e"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any values match...
With .Offset(2).Resize(.Rows.Count - 2, 1).SpecialCells(xlCellTypeVisible).Font '<--|... consider only filtered values skipping headers (2 rows), and apply formatting
.ColorIndex = 3
.Bold = True
End With
End If
.AutoFilter '<-- reset autofilter
.Resize(, 1).Offset(, 1).EntireColumn.Delete Shift:=xlToLeft '<-- delete the "2nd" column (i.e. one column offsetted to the right)
End With
End If
End With
Next currIndex
End Sub
there were two faults in your "inherited" code:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For was to be referred to abcDateRow index row instead
the formatting would be applied to all cells, were they filtered (matching) or not
I have a simple macro that copies the last line in an excel sheet and inserts further up the document. At present the macro only copies one line at a time, however I would like to be able to chose how many lines get copied.
My data is split in the middle with blank rows, hence using A500 End(xlUp), and A2 End(xlDown)
Dim i As Integer
i = Range("F1").Value
Range("A500").End(xlUp).Offset(1).Select
ActiveCell.Rows("1:3").EntireRow.Copy
Range("A2").Select
Selection.End(xlDown).Offset(1).EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
I added the Rows("1:3") to select three rows, but how can I use the number stored in F1 to select the number of rows to copy?
I tried Rows("1:i") but im aware it doesn't quite work like that.
Any guidance would be helpful thank you.
I added the Rows("1:3") to select three rows, but how can I use the number stored in F1 to select the number of rows to copy?
You can use following
Dim NumofRows As Integer
NumofRows = ActiveSheet.Range("F1").Value2
ActiveSheet.Rows("1:" &NumofRows ).EntireRow.Copy
Just keep the variable out of double quotes
Rows("1:" & i)