All three sheets will have the same column headings in row 1. On the first and second sheets in the workbook (titled "Monthly" and "Annual" respectively), I am using conditional formatting to color cells in columns Y and AC based upon there values as determined by a formula (Yellow if the calculation returns a value less than 90, Red if the value returned is 0 or a negative number). What I would like a macro to do is to copy the entire row from column A through column AD to a third sheet (titled "Maint Due"). It would also be nice if this process were automated so that anytime the values in columns Y and AC changed in the "Monthly" or "Annual" sheets, the information in the "Maint Due" sheet was automatically updated (but if I have to rerun the macro manually for that to happen it's not a big deal).
I've never used the Macro recorder and I can only figure out how to create a macro to copy and paste, so I had no luck there. After doing some more searching and watching some videos I cobbled this together:
Sub Show_on_Maint()
x = 2
'Sets the starting row
Do While Cells(x, 2) <> ""
'Continue to evaluate until a blank cell is reached
If Cells(x, 25) <= 90 Then
'Evaluates the cell in column Y to determine if the value
' is less than or equal to 90
Sheets("Monthly").Rows(x).Copy Sheets("Maint Due").Range("A2")
'Copies the row to the Maint Due sheet
Else
If Cells(x, 29) <= 90 Then
'Evaluates the cell in column AC to determine if the value
' is less than or equal to 90
Sheets("Monthly").Rows(x).Copy Sheets("Maint Due").Range("A2")
'Copies the row to the Maint Due sheet
End If
End If
x = x + 1
Loop
End Sub
When I run/debug it I get a Loop without Do error. I think my logic is sound but I don't have enough experience to figure out why I'm getting that error.
EDIT: Fixed the missing End If before x = x + 1
Now I receive a runtime error 9 "Subscript out of range" at: Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")
EDIT: Fixed sheet names. Macro now runs without errors but doesn't appear to do anything. Also edited main post for brevity.
You code snippet contains multiple error. The first 'Loop without Do error' has been fixed in comments. The second one, 'Subscript out of range' is self-descriptive, so check the maximum value of x+1 by adding
Debug.Print x = x + 1
to your loop. Also, make sure that you are not referencing a non-existing Worksheet (i.e. Sheets("Sheet6")) in your copy statement.
Hope this will help.
Related
I've got some VBA scirpt in excel that copies unique values from Column A, to column E then should total values from column B into column F for each. I found the snippet below online and have been editing it to fit my spreadsheet.
Original snippet that works in the example workbook to copy values from column B to column K and sums column I into column L.
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns( _
"B:B"), CopyToRange:=Range("'Example1'!K1"), Unique:=True
For i = 2 To Cells(Rows.Count, 11).End(xlUp).Row
Cells(i, "L").FormulaR1C1 = "=SUMIF(C[-10],RC[-1],C[-3])"
Next i
My edited code that does copy the unique value from A into E, but does not perform the sum:
Range("A5:A30").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("'Sheet1'!E7"), Unique:=True
For i = 2 To Cells(Rows.Count, 11).End(xlUp).Row
Cells(i, "F6").FormulaR1C1 = "=SUMIF(C[-4],RC[-1],C[-4])"
Next i
The part I think is wrong is the
For i = 2 To Cells(Rows.Count, 11).End(x1Up).Row
but I'm sure sure the meaning of this line, especially where it has 11. Anyone have any idea why this isn't working?
#Jarom
Edit: My spreadsheet looks like this when I run the edited code, its not totaling properly and giving 0 value.
{Part Quantity Order Number Part Needed Scanned
6116022-42ID 28 041981
6116022-42ID 13 041981 Part Number 0
6116126-01 42 041981 6116022-42ID 0
6116784-15 42 041981 6116126-01 0
6116022-42ID 1 041981 6116784-15 0 }
The cells function references a cell based on row and column numbers like this cells(row reference,column reference). So cells(1,2) references the cell B1.
It does look like the problem is in your loop. With a for loop you run an operation a certain amount of times based on the number of a variable.
The first line identifies how many iterations of the loop it will do. i is the variable the sets the loop. i starts at 7 and goes to cells(7,5).end(xldown).Rows. The cells(7,5).end(xldown).Rows code goes to cell E7 and gets the row number of the bottom of the group of populated cells (it does the equivalent of the ctrl + down arrow and gets the row number). That way the loop iterates starting at cell E7 and goes to the lowest of the populated group cells in the column E. Notice that the code in the loop has a reference to i in the row part of the cells function. i increases with every iteration of the loop, so the input to the cells function increases every loop, which is how the loop goes down one row for every iteration.
Sub test()
Range("A5:A30").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("'Sheet1'!E7"), Unique:=True
For i = 7 To Cells(7, 5).End(xlDown).Row
Cells(i, 6).Value = Application.WorksheetFunction.SumIf(Range("A:A"), Cells(i, 5),Range("B:B"))
Next i
End Sub
I hope that this helps you understand what the code is doing.
I'm running VBA to fill in all cells using last row last col. But my VBA fills in from B3 and until last row, and then adds a line below the last row and fills in to last col.
The code looks like this:
Sub RUNFILL()
With Worksheets("Sheet3").Range("B3")
Set Target = .Range(.Cells(1, Columns.Count).End(xlToLeft), Cells(Rows.Count, "A").End(xlUp))
Target.FormulaLocal = "=INDEKS(Sheet1!$N:$N;MATCH(Sheet3!$A:$A&Sheet3!B$1;Sheet1!$R:$R;0))"
End With
End Sub
I'm not sure why it fills in that way, so I'm hoping that someone can see the problem and help me correct it.
Consider that
Worksheets("Sheet3").Range("B3").Range("A1")
is equivalent to
Worksheets("Sheet3").Range("B3")
and that
Worksheets("Sheet3").Range("B3").Range("C5:D10")
is equivalent to
Worksheets("Sheet3").Range("D7:E12")
Your
With Worksheets("Sheet3").Range("B3")
Set Target = .Range(...)
End With
is equivalent to
Set Target = Worksheets("Sheet3").Range("B3").Range(...)
which is why you are not setting it to the area you think you should be.
But I have no idea why Worksheets("Sheet3").Range("B3").Cells(1, ActiveSheet.Columns.Count) (the expanded equivalent of .Cells(1, Columns.Count) in your code) is not crashing out, as that is (assuming Sheet3 is active) equivalent to Cells(2 + 1, 1 + Columns.Count) which will give a 1004 error due to referencing a column beyond the right-hand limit. (And does give that error when I try to run your code.)
And I also have no idea why your code is filling in column B to the last row (but no other columns after B) and is then inserting one extra line (not two) below that which does extend beyond column B.
I found a code online which works but I am failing to change it for my purpose. Each entry in my spreadsheet contains different formulas as well as an Iferror function with the aim of making cells with error messages appear as blank. For example lets say a cell E3 is dependent on cell F3 with a certain formula (for clarification lets say F3/2.5). It is obvious if there is no entry in cell F3 then an error message would display in cell E3. For this reason, I use the IFERROR function to display the cell as blank. The difficulty arises when I want to delete blank rows after a click on the macro button. However, since that cell does have an entry (a formula which in turn returns an error message), that cell does not delete. Also I need to run this code over 3 different selection ranges. Please can someone help! The code I found was from a different thread on this forum and is:
`sub foo()
dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range("A1:Z50")
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next
End Sub`
Thanks Alot!
EDIT: If statement added to the autofilter as it was deleting a row when there were no blanks
You will want to set up a column in the spreadsheet with the following sumproduct:
=SUMPRODUCT((LEN(A1:F1)>0)*1)
This is calculating how many cells' values have a length more than 0 hence are not blank, you will need to adjust cell references accordingly as I tested on a small sample of fake data.
Following this you can just loop:
For i = rows To 1 Step (-1)
If Cells(i,"G") = 0 Then r.rows(i).Delete 'My formula is in column "G"
Next
Or set up an auto-filter and delete entire rows of the visible cells:
Dim lrow As Integer
If Not WorksheetFunction.CountIf(Range("G:G"), "0") = 0 Then
Range("A1:G1").AutoFilter
Range("A1:G1").AutoFilter Field:=7, Criteria1:="0"
lrow = Cells(rows.Count, 7).End(xlUp).Row + 1
Range("G2:G" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("A1:G1").AutoFilter
End If
The only problem with using a leading column to calculate for this is if you have a lot of data coming and going as you will need to replenish the formula, though you could use auto complete in the code i guess.
I have a macro that increase a cell by 1 on the active sheet but I need to change the code to increase a number on a different sheet without selecting the sheet that I want to increase the number on
Example: I have 5 sheets that are the same and run the same macro and the 6th sheet I have has a invoice number that I need to increase by 1 without selecting it
Here's the code I'm using now
Range("X1").Value = Range("X1").Value + 1
I've tried
Sheets("sheet6").Range("O2").Value = Range("O2").Value + 1
but it just make the cell value 1
If the cell has nothing or zero, it will put 1 in the cell. If the cell has a number, it will put the number + 1. If the cell has a text, it will bring an error.
Beware that typing Range("O2") will take the range from the sheet where the code is. It's not necessarily "sheet 6". (So if in that sheet the value is empty, it will result in 1)
Use Sheets("sheet6") on both sides of the assignment.
Sheets("sheet6").Range("O2").Value = Sheets("sheet6").Range("O2").Value + 1
I am working on a macro to move data from one sheet to another based on matching cell values.
Let's say I have 2 sheets, Sheet1 & Sheet2, respectively.
Sheet1 contains data that I wanted to be copied into Sheet2.
Sheet2 contains a value in column "C", and this value with have multiple matches in column "C" of
Sheet1 (which are already sorted and same values are grouped together).
My overall goal is to copy cells from Sheet1 to Sheet2 based on matching values in column "C". I want to insert these values one row below the row with matching column "C" values.
The difficulty lies in the fact that the range of values copied from Sheet1 to Sheet2 will differ with each different value in Column "c" of Sheet2, because there will be a different number of rows with respect to a particular cell value.
(I would show a simple picture for this, but it won't allow me to post a picture due to low post count - I can email this if needed for clarification)
I am okay with basic macro stuff and rely on the Macro Record for some stuff as well. But with my current knowledge and lack of the macro recorder's ability to make a macro like this, I am just stumped!
My request:
Help with macro that selects a range of cells based on matching cell values to copy
Help with inserting the copied range starting 1 row below the cell value of interest (cell value is row 2, insert cells starting at row 3)
Have this repeated for each value listed in Sheet2
I think I can figure the basic coding with this. If I can just get help with the particular string that does what I am looking for would be great! I am not trying to just be handed the answer, but I have been working on this issue for 8+hrs and can't find anything online that is similar to this...
This code assumes that you have sorted the data as you have in the example:
Sub transfer()
'If everything is sorted, you can do it like this:
Dim x, y 'x is the sheet1 row, y is the sheet2 row
y = 2 'they start at the same place x = 2, y = 2
For x = 2 To Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
If Sheets(1).Cells(x, 1) = Sheets(2).Cells(y, 1) Then 'If the cell value matches
Sheets(1).Range("A" & x).Copy 'Copy the cell value from Sheet1
Sheets(2).Cells(y + 1, 1).Insert Shift:=xlDown 'And insert it below the Sheet2 Cell
'Then copy the rest of the data (columns C and D)
Sheets(1).Range("C" & x & ":D" & x).Copy Destination:=Sheets(2).Cells(y + 1, 2)
Else
x = x - 1 'We haven't found a match for this cell yet so check it again
End If
y = y + 1 'After incrementing y
Next x
End Sub
Sorry for slow reply - I can explain the code to you soon if need be!
Hope this helps! :)
I wrote this specifically for the example you gave me, so hopefully you are able to build upon this concept if your needs change.