Thank you in advance. I am pretty new to VBA I am trying to have a single column of cells copied from one column and pasted into a number based on a single criteria, which can change. I have a list in column E and a list in Column F. I want to be able to pull data from only certain cells in column E based on the adjacent cell in column F. Basically, whatever name I type into "L7", the macro will pull any data from column E that corresponds to that name. This is what I have so far:
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Value = "" then Exit Sub
Dim rn
rn = 15
If Target.row = 7 And Target.Column = 12 Then
For Each cel in Range("E:E")
If cel.Offset(0,1).value = cel.Value Then
Range("L" & rn).Value = cel.Value
rn = rn+1
End If
Next cel
End If
End Sub
Now, this does what I want it to do. I even works if I change the name in cell "L7". The problem is that it does not replace all the data from the previous time the macro ran. If I have a list of 20 names and 10 names and run the macro to pull the list of 20 names first, it won't clear out the extra names from that list when I pull the second.
I attempted several different things on this. I tried:
Sub Clear_cells()
Sheets("Sheet1").Range("L15:L100").ClearContents
End Sub
That didn't return any error messages but nothing happened.
I then tried:
If Range("L15:100").Value <> "" Then
Range("L15:100").ClearContents
End If
That line of code gave me a type 13 mismatch error.
Simply put, I need the entire range of cells where the data is being pasted to change and there be no leftover data from the previous time the macro ran.
Your help is much appreciated.
You can call the other macro from within your code:
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Value = "" then Exit Sub
Call Clear_Cells()
Dim rn
rn = 15
If Target.row = 7 And Target.Column = 12 Then
For Each cel in Range("E:E")
If cel.Offset(0,1).value = cel.Value Then
Range("L" & rn).Value = cel.Value
rn = rn+1
End If
Next cel
End If
End Sub
Note that this can also be done using array formulas, which I feel is a better option as code will not be run every time a cell changes on the worksheet.
Related
I am trying to create add some code to my macro to add a blank row whenever the value in column "B" is blank. I have the following code, but it is not doing what I want it to. It is entering too many blank rows.
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Insert
Sheets("Attendance Audit Hastus").Protect
Any ideas of how I can accomplish this?
If there are four adjacent/consecutive blank cells like B4:B7, the code in the question will insert four rows above them. Try this. It will insert only one row below the blank cells. So the new row will be B8 if the blank cells are B4:B7
Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert
Next
End Sub
EDIT
And if you want one row above the blank cells, replace ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert with ar.Cells(1, 1).EntireRow.Insert
For inserting two rows above the blank cells as per comment below
Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
ar.Cells(1, 1).Resize(2, 1).EntireRow.Insert
Next
End Sub
In order to get all cells in column "B" until the last one, you can do this:
Last_Cell_In_B = Columns("B:B").SpecialCells(xlCellTypeLastCell).Row
Range("B1", "B" & Last_Cell_In_B).Select
Like this, you only add empty rows inside your array, not outside of it.
Your code works perfectly in a standard module, so I think you are trying to use its in a event case, in sheet "Attendance Audit Hastus" right? So you need to double click in your sheet icon in project tree and put this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim MRange As Range
Set MRange = Range("B:B")
If Not Intersect(Target, MRange) Is Nothing Then
For Each cell In Target
MRange.SpecialCells(xlCellTypeBlanks).Select
Next cell
End If
Application.EnableEvents = False
Selection.EntireRow.Insert
Application.EnableEvents = True
End Sub
Note the Application.EnableEvents = False is used here to prevent prevent an infinite loop of cascading events. After the action you need to set Application.EnableEvents = True to return your normal process.
Use Case: For each cell in Column A (RangeK5:K700) that has the specific text ("Week 1" in this example) in cell B2, the row in the table that contains that specific text will be hidden.
I have code that works, but it takes a long time since the table I am currently 'filtering' is large and will get more rows as time goes on. I'm wondering if there is a way to speed up the code. I'm not much of an object oriented expert so I do tend to code the 'long' way. I think (my terminology will be incorrect so excuse me) that if I could somehow keep track of all of the rows to hide and then hide them at the end instead of at each loop, it would be faster. Is that possible?
I 'figured' this out by google searches & prayer so if there are any changes that can be made I'd appreciate hearing them. Thanks so much in advance!!
Note: B2 can have up to 13 different options (Week 1 --> Week 13 etc). I'll only show the code if B2 is "Week 1"
Sub CycleThroughWorksheet()
Set Target = Range("B2")
If Target.Value = "Week 1" Then
Call HideWeek2
Call HideWeek3
Call HideWeek4
Call HideWeek5
Call HideWeek6
Call HideWeek7
Call HideWeek8
Call HideWeek9
Call HideWeek10
Call HideWeek11
Call HideWeek12
Call HideWeek13
End If
End Sub
------
Sub HideWeek1()
For Each Cell In Worksheets("Gantt Table").Range("K5:K700").Cells
If Cell.Text = "Week 1" Then
Cell.EntireRow.Hidden = True
End If
Next
End Sub
-------
Sub RunWeekView()
Call PreventScreenFlicker
Rows.EntireRow.Hidden = False
Call CycleThroughWorksheet
End Sub
You can batch the hide operation like this:
Sub HideWeek(WeekNum As Long)
Dim rng As Range
For Each Cell In Worksheets("Gantt Table").Range("K5:K700").Cells
If Cell.Text = "Week " & WeekNum Then
If rng is nothing then
Set rng = Cell
Else
Set rng = Application.Union(rng, Cell)
End If
End If
Next
If not rng is nothing then rng.entirerow.hidden = true
End Sub
Call with (eg)
HideWeek 1
HideWeek 2
etc.
Depending on what the rest of your code looks like there are likely other changes you could make to reduce the size of your code. If you're typically hiding most of the rows then it might be better to first hide everything, then only show the rows you want.
You can use a Worksheet_Change event to AutoFilter your data based on the value in Range("B2"). Right click your worksheet tab and select View Code, copy and place this code in your worksheet object code window in the Visual Basic for Applications window(the DEVELOPER tab must be enabled). When you change the Week # in the target cell(B2), the code will hide the rows that contain the target Week # in Column K, and show the other Weeks, by using "<>", in the Criteria1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
With Range("K4", Range("K" & Rows.Count).End(xlUp))
.AutoFilter 1, Criteria1:="<>" & Target.Value
On Error Resume Next
End With
End If
End Sub
If you actually want to only show the Week #, you can change to code by removing the "<>"...
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
With Range("K4", Range("K" & Rows.Count).End(xlUp))
.AutoFilter 1, Criteria1:= Target.Value
On Error Resume Next
End With
End If
End Sub
I'm trying to make a vba code to check each cell in two sheets if they are equal. If not, create an empty row above and move on for both of the sheets.
I don't have much experience using Vba so I'm a little confused. I hope you've understood my problem and a appreciate since now.
Private Sub compare_cells(ByVal Target As Range)
If Target Is Nothing Then Next
If Cells(Target.Row, 1).Value = 'another row ' Cells(Target.Row, 4).Value Then
Next
Else
'inset empty row above of the sheet with the missing value
Next
End If
End Sub
The code above is really ugly, that's why I need help. The data seems like this:
sheet 1:
sheet 2:
If my understanding is correct in your question above... You want to produce an empty row, above ANY values that DO NOT match between two worksheets.
Based on this, and the above code, you are not too FAR off the right track.
Try the below code...
Private Sub compare_cells(ByVal Target1 As Range, ByVal Target2 As Range)
If Target1 Is Nothing Then Exit Sub
If Target2 Is Nothing Then Exit Sub
Dim ws1, ws2 As Worksheet
Set ws1 = Sheets(Target1.Parent.Name)
Set ws2 = Sheets(Target2.Parent.Name)
If Target1.Value <> Target2.Value Then
' If they don't match place your code here
ws1.Range(Target1.Row & ":" & Target1.Row).Insert Shift:=xlDown
ws2.Range(Target2.Row & ":" & Target2.Row).Insert Shift:=xlDown
End If
End Sub
You can call this by using this within another macro...
Call compare_cells(Sheets("Sheet1").Range("A1"), Sheets("Sheet2").Range("D1"))
If you use the above macro, then this will compare Range "A1" on Sheet1, with Range "D1" on Sheet 2. If these two cells do not match, then it will insert a row above both A1, and D1.
I have a spread sheet which is used for basic scheduling of tasks.
Dates for the calendar run along Row 1 from O-NO and everything below is job related including due dates.
I am trying to automatically add a note to the calendar section of the sheet when a date is added to column E. The word “Due Date” is update to the corresponding text row/date column.
Colum E = due dates, Columns O to NO (rows are infinite) are days Jan – Dec. I have created the cell formula =IF((AND($E452=$1:$1)),"Due Date","") which is cell specific.
I need to keep the cells clear of formulas because they are used for adding other details so a Macro is the way to go.
I thought I could convert the formula to a macro and then manipulate the code to do what I need across all of the calendar cells. Below is the result.
Sub DueDate()
'
' DueDate Macro
'
'
Range("IM451").Select
ActiveCell.FormulaR1C1 = "=IF((AND(RC5=R1)),""Due Date"","""")"
Range("IM452").Select
End Sub
Firstly I tried a number of ways just to get this macro to run automatically without having to manually run it. For some reason I couldn’t get it to work.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
MACRO CODE HERE
End If
End Sub
Plus a couple of other versions
Second step was to get it to work across all of the calender cells, another fail.
Would really appreciate some assistance on this.
Thank you
CRB
If I understand what you're trying to do correctly, then try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
If Target.Cells.Count = 1 And Target.Column = 5 Then
Set c = Range(Cells(Target.Row, "N"), Cells(Target.Row, "NO")).Find("Due Date")
If Not c Is Nothing Then c.ClearContents
Set c = Nothing
If IsDate(Target.Value) Then
Set c = Range("N1:NO1").Find(Target.Value)
If Not c Is Nothing Then Cells(Target.Row, c.Column).Value = "Due Date"
End If
End If
Application.EnableEvents = True
End Sub
When a date is entered in column E, this will look for that date in range N1:NO1, and if the date is found, will insert "Due Date" in the matching column of the target row.
VBA beginner here.
I have project where I have specified input cells for the user. When one of these input cells is changed, it needs to run a few lines of code that are specific to only that one cell. If the user clears the contents of the cell, I want the code to replace the blank cell with the value "0".
The code below simulates what I am trying to achieve. It is written in the same form as my project but is more succinct.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row = 1 Then
Range("B1").Value = "Changed 1" 'Just something specific to this cell. Not important
If IsEmpty(Sheet1.Range("A1")) Then Sheet1.Range("A1").Value = 0
End If
If Target.Column = 1 And Target.Row = 2 Then
Range("B2").Value = "Changed 2" 'Just something specific to this cell. Not important
If IsEmpty(Sheet1.Range("A2")) Then Sheet1.Range("A2").Value = 0
End If
If Target.Column = 1 And Target.Row = 3 Then
Range("B3").Value = "Changed 3" 'Just something specific to this cell. Not important
If IsEmpty(Sheet1.Range("A3")) Then Sheet1.Range("A3").Value = 0
End If
End Sub
Everything above works fine when the changes are performed on single cells. If the user selects all the cells and presses the delete key, it only runs the code for the first cell. I want it to run for all the selected (deleted) cells.
Any advice on how to simultaneously run the Worksheet_Change across multiple cells?
Thanks
When you have a change event that works just fine on a single cell, you can make a few adjustments to ensure that it also works when you change a range of cells in one go, like when you paste three cells into A1 to A3
You may want to apply an approach similar to this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cel As Range
Dim myRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
If Not Intersect(Target, Range("A1:A3")) Is Nothing Then ' watch all the cells in this range
For Each cel In Target ' do the next steps for each cell that was changed
myRow = cel.Row
Range("B" & myRow).Value = "Changed " & Target.Row 'Just something specific to this cell. Not important
Application.EnableEvents = False
If IsEmpty(ws.Range("A" & myRow)) Then Sheet1.Range("A" & myRow).Value = 0
Application.EnableEvents = True
Next cel
End If
End Sub
Explanation:
If Not Intersect(Target, Range("A1:A3")) Is Nothing Then -- only act on changes to cells A1 to A3
For Each cel In Target - do the same thing for all cells that have been changed
Range("B" & myRow).Value = "Changed " & Target.Row - enter some value into column B of the current row
In the next step of the macro we will possibly enter some data into the cells we are monitoring for a change, i.e. A1 to A3. A change in these cells will trigger this macro. This macro will write into the cells. A change in the cells will trigger this macro ....
You see where this is going. In order to avoid an endless loop, we turn off any event triggered macros, e.g. macros that fire when a cell is changed. So we turn off event monitoring with this statement.
Application.EnableEvents = False - Now any events like "a cell has been changed" will be ignored.
We can now write a value into column A and that will not trigger the macro again. Great. We do whatever we need to do to cells A1 to A3 and then we turn event monitoring back on.
Application.EnableEvents = True
Then we go to the next cell (if any) in the range that triggered this macro.
Let me know if that helps or if you need a bit more detail. These things take a little learning curve.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Cells(1, 1)) Is Nothing Then
Range("B1").Value = "Changed 1" 'Just something specific to this cell. Not important
If IsEmpty(Sheet1.Range("A1")) Then Sheet1.Range("A1").Value = 0
End If
If Not Application.Intersect(Target, Cells(1, 2)) Is Nothing Then
Range("B2").Value = "Changed 2" 'Just something specific to this cell. Not important
If IsEmpty(Sheet1.Range("A2")) Then Sheet1.Range("A2").Value = 0
End If
If Not Application.Intersect(Target, Cells(1, 3)) Then
Range("B3").Value = "Changed 3" 'Just something specific to this cell. Not important
If IsEmpty(Sheet1.Range("A3")) Then Sheet1.Range("A3").Value = 0
End If
End Sub