I have a spreadsheet that we are constantly adding data to. This data is imported from a report and added to the end of the spreadsheet. I have a macro already in place to remove duplicates. There is another macro that will highlight specific rows based on one of the cells contents, and then make a copy of the row and paste it into another sheet within the workbook. One of the columns requires a number as it's data. However, on occasion, this number is not available and we input "RCA Pending" into that cell.
What I need to do is have that cell highlighted in red. But, once the number is input into the cell, I need the cell color to change back to 'no fill', unless that row is highlighted from the previous macro that was run.
Expected result sample
I am not opposed to combining these macros if that is easier.
Here is the first macro listed above:
' This part highlights all rows that are Disputed
' Keyboard Shortcut: CTRL+SHIFT+L
Dim row As Range
For Each row In ActiveSheet.UsedRange.Rows
If row.Cells(1, "F").Value = "After Dispute For SBU" Then
row.Interior.ColorIndex = 6
Else
row.Interior.ColorIndex = xlNone
End If
Next row
' This part clears the Disputed worksheet and copies all disputed rows to the sheet
With ThisWorkbook.Worksheets("Disputed")
Range(.Range("A2"), .UsedRange.Offset(1, 0)).EntireRow.Delete
End With
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).row
lr2 = Sheets("Disputed").Cells(Rows.Count, "A").End(xlUp).row
For r = lr To 2 Step -1
If Range("F" & r).Value = "After Dispute For SBU" Then
Rows(r).Copy Destination:=Sheets("Disputed").Range("A" & lr2 + 1)
lr2 = Sheets("Disputed").Cells(Rows.Count, "A").End(xlUp).row
End If
Range("A2").Select
Next r
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
End Sub
How about just using conditional formatting on the data. You would use a formula like
=$A2="RCA Pending"
which assumes that the data starts in A2 and the column in question is A. You would need to select all of the columns in all of the rows, starting at A2, and then apply the CF
Related
I have a table with 15 columns. I'm trying to copy and paste 3 of the columns into another sheet and then duplicate that info below itself in the destination sheet a specified number of times based on the number layers in the test I'm conducting. I'm having trouble with the code finding the bottom row of the copied data and I haven't found code that will eliminate the gaps in the data.
this is my first post so I cant add pictures yet.
here's my current code for the button that is supposed to populate the destination sheet:
Private Sub PRTButton_Click()
CopyInfo
PasteInfo
End Sub
Sub CopyInfo()
Dim aLastRow As Long
aLastRow = Sheets("Test Ammo").Cells(Rows.Count, 1).End(xlUp).Row
'ammo description
Sheets("PRT Endurance").Range("B6:B" & aLastRow - 1).Value = Sheets("Test Ammo").Range("O64:O113" & aLastRow).Value
'Ammo Spec
Sheets("PRT Endurance").Range("C6:C" & aLastRow - 1).Value = Sheets("Test Ammo").Range("C64:c113" & aLastRow).Value
'QTY Shot
Sheets("PRT Endurance").Range("D6:D" & aLastRow - 1).Value = Sheets("Test Ammo").Range("N64:N113" & aLastRow).Value
End Sub
Sub PasteInfo()
Dim LRow As Long
With ActiveSheet
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Range("B6:D" & LRow).Copy
MsgBox "Info is already in clipboard. Select your layers from the dropdown and paste at the bottom of the copied info for each layer."
End Sub
I know i haven't told the code to only copy the values with a number in the M column and paste them into the destination sheet. for reference, I only want to copy the rows that have a value in the M column in my origin sheet. I'm not sure how to tell the code to select the 3 row dynamic range in the destination sheet and paste it a certain amount of times below it.
If I missed any explanations or there's any confusion, let me know and I'll try to clarify.
Origin table
Table after pressing "Populate ammo info"
I am trying to paste a selection of rows to a new sheet.
It worked previously, but now run-time error 1004 tells me that I can't paste because the copy area and paste area aren't the same size.
When I attempt to run the code, I am sure to have the A1 cell of the new sheet selected.
When I debug, it takes me to the ActiveSheet.Paste line.
Sub exportconditionstarttoend()
Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets("ETM ETM0007").Range("W63000").End(xlUp).Row
With ActiveWorkbook.Worksheets("ETM ETM0007").Range("W1:W" & lastrow)
For rownum = 1 To lastrow
Do
If .Cells(rownum, 1).Value = "Condition 1 - Price 0.25" Then
startrow = rownum
End If
rownum = rownum + 1
If (rownum > lastrow) Then Exit For
Loop Until .Cells(rownum, 1).Value = "Condition 1 - Price 0.25 - End"
endrow = rownum
rownum = rownum + 1
Worksheets("ETM ETM0007").Range(startrow & ":" & endrow).Copy
Sheets("Result").Select
Range("W1").Select
ActiveSheet.Paste
Next
End With
End Sub
You are getting the error because you are copying every column and then trying to paste every column starting at cell W1. You are trying to paste 16,384 columns into a range that only has 16,362 columns. This leaves you with a 22 column deficit and thus the paste size error.
If you are copying every column, you always need to paste on Column A.
Similarly, if you are copying every row, you always need to paste on Row 1.
i.e. change Range("W1").Select to Range("A1").Select. Note you don't need to .Select a range to copy or paste it - see this post for reasoning and best practice.
Do you really need to copy every column?
The best solution is to limit the number of columns you need to copy either by hard coding the column range or dynamically defining the column range.
"I am sure to have the A1 cell of the new sheet selected" - from your code Range("W1").Select looks like your last selected cell is W1, so you can't paste a whole row there. The solution is to change W1 to A1 or select not the entire row but the range of the table, for example,
Worksheets ("ETM ETM0007"). Range ("A" & Startrow & ":" & "I" & Endrow) .copy or any other col/row range copy method.
I am completely new to VBA, so this task is a bit difficult for me but I bet it is easy for you guys.
I am trying to create a macro command that can automatically convert a series of dates from text to a date format that excel can recognize. This is a task which I regularly perform, so it would be very time saving to have a macro doing it for me.
Basically, I regularly download a time series of e.g. the historical price of a stock. The length of the time series varies every time.
Next I will need to convert the dates from the downloaded data to a format excel can recognize.
To do so I use the following code:
=DATE(RIGHT(B2,4),MONTH("1 "&MID(B2,4,3)),LEFT(B2,2))
in the cell adjacent to the first row of the date series.
I then auto-fill this formula to the end of the series.
I have created a macro that performs this task for me, using the following code:
Sub FacsetDates()
' FacsetDates Macro
' Turn Factset dates into excel format
'
' Keyboard Shortcut: Ctrl+Shift+D
ActiveCell.FormulaR1C1 = _
"=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
Selection.End(xlToLeft).Select
Dim Lastrow As Long
Lastrow = Cells(Rows.Count - 1, ActiveCell.Column).End(xlUp).Row
Selection.End(xlToRight).Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & Lastrow - 1)
ActiveCell.Range("A1:A" & Lastrow - 1).Select
End Sub
My problem is that this code only works if the date series start from row 2.
If the the series is inserted from row 1 the auto-fill will stop one row short and if the series start from row 3, the auto-fill will fill out one row too much (compared to the length of the data series)
I would like a macro that works no matter which row the data series start.
E.g. I would like the macro to work even if the date series begin at B10.
I imagine that the solution is to set the data series as an array in VBA and then perform a loop that manipulate each string of text, and then finally paste the manipulated data in the adjacent column.
I have started producing the following code:
Sub FSdate()
Dim arrMarks() As Long
Lastrow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
ReDim arrMarks(1 To Lastrow)
Dim i As Long
For i = LBound(arrMarks) To UBound(arrMarks)
arrMarks(i) = ActiveCell
Next i
In which I try to first define the array and its size, and then "copy" the string of text from the active cell (being the first row of the data series), but this code fails.
After having defined the array, I imagined to run a loop that use the DATE function from above to manipulate every single entry in the array. But my current skills in VBA falls short here, and I simply do not know how to proceed.
Can anyone help create such a code?
or even, do you guys have inputs to alternative ways of doing this task?
Probably the initial code can be manipulated to work no matter which row the data series start.
I hope somebody is able and willing to help me!
This is a vary simplified breakdown of #Dave answer, since you want to use the cell you are selecting to start from. First; set your last row by counting the rows in the column to the left from your active cell. Second; set your range from the active cell to the last row variable. Third: write your formula into the range. Note: the lRow - ActiveCell.Row + 1 adjusts your range based on the activecell row number.
Dim lRow As Long
lRow = Cells(Rows.Count, ActiveCell.Offset(, -1).Column).End(xlUp).Row
ActiveCell.Resize(lRow - ActiveCell.Row + 1).FormulaR1C1 = "=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
An easier way to accomplish your task; by overwriting the current text would be to use TextToColumns
ActiveSheet.Columns("F").TextToColumns Destination:=ActiveSheet.Columns("F"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 3), TrailingMinusNumbers:=True
Columns("F").NumberFormat = "m/d/yyyy"
If we first look at what's happening:
Sub FacsetDates()
' FacsetDates Macro
' Turn Factset dates into excel format
'
' Keyboard Shortcut: Ctrl+Shift+D
' Enter Formula in the current cell
ActiveCell.FormulaR1C1 = _
"=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
' Move to the leftmost cell in a contiguous range from the current cell
Selection.End(xlToLeft).Select
Dim Lastrow As Long
' Get the row number of the bottom cell in the same column as the now selected cell
Lastrow = Cells(Rows.Count - 1, ActiveCell.Column).End(xlUp).Row
' Move to the rightmost cell in a contiguous range from the now selected cell
Selection.End(xlToRight).Select
' Fill down from the current cell by the same number of cells in the range from A1 to the last row
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & Lastrow - 1)
ActiveCell.Range("A1:A" & Lastrow - 1).Select
End Sub
Where your issue with the range comes in is that ActiveCell.Range("A1:A" & Lastrow - 1) does not refer to rows 1 to x in the sheet, it refers to rows 1 to x in your range which starts at row 2 or 3 or whatever.
You will also learn very quickly that changing selections in code is time/resource consuming and is susceptible to bugs creeping in eg if selections change during the running of your code.
I would consider hardcoding the column where you are outputting your formula if it is always going to be the same to and to avoid making selections. You can do this and input the formula directly into column C like so:
Sub FacsetDates2()
Dim Lastrow As Long
' Get the row number of the bottom cell in column A
Lastrow = Cells(Rows.Count - 1, 1).End(xlUp).Row
Range("C2:C" & Lastrow).FormulaR1C1 = "=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
End Sub
EDIT -
Using the active cell and going to the end of the range as defined in column A you could use this:
Sub FacsetDates2()
Dim Lastrow As Long
Dim c As Range
Dim currentRow As Long
Dim currentColumn As String
' Store a reference to the active cell
Set c = ActiveCell
' Get the row number and column name of the active cell
currentRow = c.Row
currentColumn = Replace(c.Address, currentRow, "")
' Get the row number of the bottom cell in column A
Lastrow = Cells(Rows.Count - 1, 1).End(xlUp).Row
Range(c.Address & ":" & currentColumn & Lastrow).FormulaR1C1 = "=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
End Sub
I have looked through the forum, as well as Google, and I wasn't able to find an answer to what I'm trying to do.
One of the users [here][1] helped me get a code to copy data in a specific row (upon clicking a button) to the last row of a table that is found further down in the same sheet.
However, I'd like the sheet to scroll down to the last non-empty row of the table instead of scrolling manually. I understand that this can be accomplished through a combination of CTRL+SHIFT+"DOWN ARROW". However; the excel users are not very good with computers, so I am trying to make it as simple as possible to them.
Is there a VBA code that can do the job?
Thanks
So far, I am using Erin's code, which takes me to the last row of the spread sheet, instead of the last Non-Blank row. This could be because column A has formulas in all its cells, all the way down to the last cell. However, column A cells formulas are set to give blank unless there's data entered in their adjacent cells in column E.
Here's the code that I am using, which is pasted in the module.
Option Explicit
Sub copyRow()
Dim ws As Worksheet
Dim lRow As Long
' define which worksheet to work on, i.e. replace Sheet1 with the name of
your sheet
Set ws = ActiveWorkbook.Sheets("1. Clients Details")
' determine the last row with content in column E and add one
lRow = ws.Cells(Rows.count, "E").End(xlUp).Row + 1
' copy some cells into their ranges
ws.Range("E3:G3").Copy ws.Range("E" & lRow)
ws.[E1].Select
' combine H3, I3, J3, K3 and L3 and copy into column E, next empty row
ws.Range("H" & lRow) = ws.[H3] & " " & ws.[I3] & " " & ws.[J3] & ", " & ws.
[K3] & " " & ws.[L3]
' copy the other cells into their ranges
ws.Range("M3:Q3").Copy ws.Range("M" & lRow)
ws.[M1].Select
' combine H3 & I3
ws.Range("AA" & lRow) = ws.[H3] & " " & ws.[I3]
' combine J3, K3 & L3
ws.Range("AB" & lRow) = ws.[J3] & " " & ws.[K3] & " " & ws.[L3]
' copy Q3 into column Q only, if F3 = "Company"
If Worksheets("1. Clients Details").Range("F3").Value = "Company" Then
ws.Range("Q3").Copy ws.Range("Q" & lRow)
End If
Call scrollToEnd
End Sub
Sub scrollToEnd()
Dim lastrow As Long
Dim numRows As Long
numRows = Range("E1:E1000").Rows.count
lastrow = Range("E1:E1000").Columns(5).Rows(numRows).Row
ActiveSheet.Range("E" & lastrow).Activate
End Sub
Dim lastrow as long
Dim numRows as long
numRows = Range ("TableName").Rows.Count
lastRow = Range ("TableName").Columns (1).Rows(numRows).Row
Activesheet.Range("A" & lastRow).Activate
I can't test it right now, but I believe this will work. If you know the offset for your table, you can just do numRows + offset (mine are usually in A1, so I just add 1 for the header - numRows is data rows) to get your row number for the .Activate. :-)
Or to reach the same row as CTRL+SHIFT+"DOWN ARROW", regardless of the table:
With Activesheet
.Range("A" & .UsedRange.Rows(.UsedRange.Rows.Count).Row).Activate
End With
EDITED: I was thinking CTRL+END in the above code. To simulate CTRL+"DOWN ARROW" (adding SHIFT selects everything in its path...), you would actually use:
Range("A1").End(xlDown).Activate
You could simply paste this at the end of your sub since it is one line, or keep it as its own little sub if you are wanting to call it from a button-click. If it is column E that you want selected, you would simply replace "A1" with "E1".
This does assume that there are no blank cells in column E between "E1" and the last non-blank row. Otherwise, you will need to use the same logic as in your copyRow sub to find the last non-blank row:
ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Activate
This will scroll down till the last row's cell is at the top left of the screen.
Sub test()
Application.Goto Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp), True 'where 'A' is the column of the last row
End Sub
You can paste the code at the bottom of your current procedure or assign it to a button.
EDIT:
Alternatively, you can try this. This will find the last row of any column.
Sub test()
Dim lastrow As Range
Set lastrow = Sheets("Sheet1").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not lastrow Is Nothing Then Application.Goto lastrow, True
End Sub
I have an excel spread sheet set up for my partner's home business where she can input data relating to people joining the business. I am looking to have the data from that row cut and paste to a separate sheet depending on the criteria in one of the cells. The main sheet is called "Workspace".
If the person on row 6 has agreed to join the business then a "Yes" would be placed in cell V6. Once the Yes has been input I am aiming for the columns A:G to be cut and paste onto the sheet "Joined" as well as the rest of that row being deleted and preferably the rows underneath moving up one (if that is possible). The data would be pasted onto the next blank row on the "Joined" sheet.
On the flip side, if the person on row 6 states they are uninterested then a "Not Interested" would be placed in cell H6. Once the not interested has been input I am aiming for the columns A:G to be cut and paste onto the sheet "Not Interested" as well as the rest of that row being deleted, like above.
Is it also possible to have the spread sheet sort names alphabetically each time a new name is added? The starting row for data is 6.
I hope this all makes sense and really hope someone is able to assist. I am quite good when it comes to formulas but not got a clue where to start with regards to macros.
This is my code so far:
Sub Test()
For Each Cell In Sheets("Workspace").Range("V:V")
If Cell.Value = "Yes" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Joined").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Workspace").Select
End If
Next
End Sub
Here is a good starting point for you. I added comments to the code so you can see what every line does.
This sub searches for "yes" in column V and copies Range A:G of the columns with "yes" into sheet Joined. Then it deletes the entire row where the "yes" was found.
I think from here you can do the second part for "Not Accepted" on your own.
Sub Test()
Dim MatchRow As Long, FirstRow As Long, LastRow As Long
Dim Destination As Range
Dim ws As Worksheet
Set ws = Sheets("Workspace") 'define ws as sheet workspace (shortcut)
FirstRow = 6 'First row with data below headline
LastRow = ws.Cells(ws.Rows.Count, "V").End(xlUp).Row 'Get last used row in column V (so we don't need to go through the full column)
Dim i As Long
i = FirstRow
Do While i <= LastRow 'start searching for "Yes" in FirstRow and end in LastRow
If ws.Range("V" & i).Value = "Yes" Then
MatchRow = ws.Range("V" & i).Row 'remember matched row number
'find last free row in column A of sheet Joined and remember in Destination
With Sheets("Joined")
Set Destination = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
'Copy range A:G from matched row to destination found above
ws.Range("A" & MatchRow & ":G" & MatchRow).Copy Destination
'Delete copied entire row
ws.Rows(MatchRow).EntireRow.Delete
'reduce LastRow by one (because we deleted one row)
LastRow = LastRow - 1
Else
'go to next row
i = i + 1
End If
Loop
End Sub