All, I need to write a macro that does the following:
On entry data into the last blank cell in column E, sort the entire worksheet by column E in descending order
Once the worksheet is sorted:
2a. Copy the cell to the adjacent cell immediately to the left of the cell into which the data was first entered
2b. Paste the copied data into the first column of the same row from which the data was originally entered
2c. Move the cursor to the adjacent cell immediately to the right of the cell into which the data was first entered
Below, I show the sort on entry code, which works. However, I cannot then get the code to copy, paste, and move correct. My most common problem: after data entry, the rows move, but the cursor stays in the row where the data was first entered. Can anyone help? (I can't even get the indenting right on this post!)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) Is Nothing) Then
DoSort
End If
End Sub
Private Sub DoSort()
Worksheets("Sheet1").Range("A:E").Sort Key1:=Worksheets("Sheet1").Range("E1"), Order1:=xlDescending, Header:=xlYes
End Sub
Regarding 1, 2a, and 2b: It's more straightforward to do the copying before sorting. That way, the copied value will be sorted along with the rest.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
Is Nothing) Then
' First copy
Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
' Then sort
DoSort
End If
End Sub
This leaves the question (2c) of how to move the active cell to the appropriate row after the rows have been sorted. Presumably, you want the user to input further data in column F?
Again, the most straightforward solution would be to have this input happen first, and then do the sorting. This would have the added benefit that the user wouldn't have the input row jump around between inputting data in column E and column F. The sorting could even happen just once, after all the data has been entered by the user.
Of course, the above is more a design suggestion than a solution to your specific task 2c. If moving the active cell after sorting is really what you want, then the solution will inevitably be more complicated. Excel's Sort method does not return an index, to locate your entries after sorting. You will have to make an index / "serial number" yourself and search for it after sorting. This works:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newIndex As Long
If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
Is Nothing) Then
' Index the new entry in column B. (You can put the index elsewhere.)
newIndex = WorksheetFunction.Max(Range("B:B")) + 1
Target.Offset(0, -3).Value = newIndex
' Copy the entry.
Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
' Sort
DoSort
' Search for the new index after sorting. Select cell in column 6 (F).
Cells(WorksheetFunction.Match(newIndex, Range("B:B"), 0), 6).Select
End If
End Sub
Making an index is not strictly necessary if all your entries are unique (i.e. no duplicates); you could in principle just search for the entry itself. However, if there can be duplicates, then searching for the entry itself (rather than its index) will be more messy, and may lead to unwanted behaviour unless it's programmed just right. I find it much cleaner to just use an index.
I'd suggest you to save the value that has been entered and search for this value after the sorting.
Notice we may have dup data added into E column, so we'll need to store the other column's information as well until have a reliable key.
So, once you know the value(s) you need to search, find the cell containing the data you added in the column E (that might be in any other row by now, not only in the last one) and use it as an anchor to your other operations.
There are several ways to find a specific entry in a matrix (using Excel or pure VBA, as you wish). If you have problems implementing them, let us know.
Having the cell address (in column E) that contains the value that has just been added, you'll use offset functions to set adjacent values. Again, if you have problems implementing it, let us know your doubt.
Hope it helps :)
Rgds
Related
I am trying to shade every other group of visiable cells.
Each row of my data contains information on a given Order and there can be multiple rows for each order, e.g. Order 1 many have 3 rows while order 2 may have 1 row, etc. The data is sorted by Order Number so all rows for a given order are contiguous.
I have shaded each group vis a helper column (AS) containing the following formula: =IF(ROW()=2,TRUE,IF(A2=A1,AS1,NOT(AS1)))
which results in every other Order group being either TRUE or False. Then I use conditional formatting to shade every "TRUE" row.
This works until I begin filtering my data and then I can end up with either two shaded or to unshaded groups next to each other.
I think what I'm looking for is a VBA function that will compare a cell with previous VISIBLE cell and will return TRUE or FALSE if the match or not.
Any help will be much appreciated.
you can use this code that shades every other row
Sub ShadeThem()
Dim okShade As Boolean
Dim r As Range
For Each r In Range("A1", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
If okShade Then
r.EntireRow.Interior.Color = vbRed
okShade = False
Else
okShade = True
End If
Next
End Sub
I assumed your filtered data affect column A from row 1 downwards
Did they not, just change "A1" and Cells(Rows.Count, "A") to affect the needed column
In order to have it run at every new filtering, you could:
add a helper cell which counts the number of visible rows
=SUBTOTAL(103;A1:A1000)
this will trigger the Worksheet_Calculate event at every filtering
add the Worksheet_Calculate event hander in the relevant sheet code pane
Private Sub Worksheet_Calculate()
ShadeThem
End Sub
As I said in the comments, there's almost surely a better way to do what you're trying as a whole with your spreadsheet (a table!). However, if you really wanted a VBA custom formula to test if a cell is hidden or not you could use this...
Function isHiddenRow(aRange As Range) As Boolean
isHiddenRow = aRange.EntireRow.Hidden
End Function
There's some possibilities this formula assumes:
Only one cell.
Filtering impact of recalculations.
Good day dear community,
I currently have a problem with VBA/Excel that I can't find a solution to. What I want to achieve is not complicated, but I can't find a way.
Let's assume we have two columns. In any row of one column A the User enter a value and then I start a macro. This macro executes certain instructions. Among other things, this macro ensures that if a cell in column A has a value, then the value "Yes" is entered in the same row in column B. Now my problem: As soon as the user deletes the cell value in column A, the value "Yes" in column B should also be deleted. At first glance you might think that i can use this confdition:
=IF(A1="";"";yes)
The problem is that as soon as the user has entered a value in the cell, "yes" is immediately written in the cell, but this is not desired. Because this task should be taken over by the macro.
As a small side note: I have simplified my problem. Due to the structure of my project, only the macro is allowed to write "yes".
Thanks.
Evaluate Excel Formula in VBA
In your code, you will define the occupied range in column A, and apply the second line appropriately.
Option Explicit
Sub checkColumnRange()
' Some code
' Define the column range...
' e.g.:
Dim rg As Range: Set rg = Range("A1:A10")
rg.Offset(, 1).Value = Evaluate("IF(" & rg.Address(0, 0) _
& "<>"""",""Yes"","""")")
' Some code
End Sub
I have four table-formatted worksheets (A, B, C, and D) each with rows of different data beneath matching column headers. I'm trying to write a VBA macro to cut rows from one sheet and paste them into the bottom of another based on the value of a single cell in a given column. I know this has been done from one individual sheet to another and I found the basic code to do so. However, I wanted to modify that to apply across all the worksheets, account for multiple permutations of the same value, and avoid re-checking rows that are already/have been placed in their "proper" worksheet, i.e., all rows marked 'Archived' in all its various permutations in column 17 of their respective other worksheets get shuffled over to the 'D' worksheet once the word archived is typed into that cell and the enter key is pressed. I think I'm screwing up something basic here with the "<>" and "or" portions, but not sure how to fix them. I'm also not sure if it is better to link this command to the 'Enter' keystroke or just have it check the values automatically?
Sub MoveRows()
Dim k As String
a = Worksheets(k).Cells(Rows.Count,1).End(xlUp).Row
If Worksheet.Name <> "D" Then
For i = 2 To a Step -1
If Worksheets(k).Cell(i,17).Value = "Archived" or "archived" or "ARCHIVED" Then
Worksheets(k).Rows(i).Cut
Worksheets("D").Range("A1").End(xldown).Offset(1,0).Insert
End If
next i
Else 'do nothing'
End Sub
I'm trying to find the last row off column D, then move three up, and one to the right and insert data to that column.
The reason for this, is that the above cells are dynamic and can be deleted and added as you go along - the last cell and the cell I'm trying to target, doesn't contain the same reference (except from the last line in any column, which are always three down and one to the right from D (LastRow).
I haven't found a solution in similar posts.
The image shows the sheet.
The cells marked with yellow are the lastRow cell and the cell I'm trying to insert data into.
The cells marked with a blue ring, contains the dynamic cells, which gets longer/shorter depending on the situation.
You may convert that to one line rather than multiple lines.
Dim korrektion1 As Double
Private Sub CommandButton1_Click()
Range("E4").End(xlDown).Offset(-3, 0).Value = korrektion1
Unload UserForm2
End Sub
I ended up solving my problem with the following code:
Dim korrektion1 As Double
Private Sub CommandButton1_Click()
Range("E4").End(xlDown).Select
Selection.Offset(-3, 0).Select
Selection.Value = korrektion1
Unload UserForm2
End Sub
I need Help!
I am not well versed in VBA or Macros but i cannot find any other way to accomplish what i need to do without using it.
I have a sheet which i will be using to track Purchase orders, and what i need to do is; when i have a row in sheet 1 (Purchase Orders) which has been recieved i.e. the date of receipt has been recorded in column H i need for the entire row to be cut and pasted into sheet 2 (Received orders).
The header takes up the first 7 rows the rows, so i need the macro to look at rows 8-54. Once the received items are removed from sheet 1, i need the row to also be deleted or preferably for the list to be sorted by column A moving the now empty row which has been cut from open for a future entry.
Any help would be greatly appreciated.
The "Record Macro" feature should be enough to do the task you describe.. In Excel 2007, go to the Developer tab in the Ribbon, and select "Record Macro", and perform exactly the steps you are describing. It will record the equivalent VBA code, which you can then execute - or tweak/modify.
I tested this out, here's one way to do it:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim receivedDate As Range, nextOpen As Range, isect As Range
Set receivedDate = Sheet1.Range("H8:H54")
Set isect = Application.Intersect(Target, receivedDate)
If Not (isect Is Nothing) And IsDate(Target) = True Then
Set nextOpen = Sheet2.Range("A1").End(xlDown).Offset(1, 0)
Target.EntireRow.Copy Destination:=nextOpen.EntireRow
Target.EntireRow.Delete
End If
Application.EnableEvents = True
End Sub
This would be pasted into the Sheet1 code. Any time a cell is changed on sheet1, the code checks to see if it's in the critical range that you specified. (H8:H54) If it is, it then checks to see if it's a date. If it is, it then copies the entire row, puts it in the next open row on Sheet2, and deletes the original row. The cells below it will get shifted up so there are no gaps.
Since the code functions on a cell changing event, it disables "Application.EnableEvents" in order to avoid a loop of changing a cell to call an event which changes a cell to call an event... etc.