I need to have the user select a range of cells with their mouse and then run a macro to add +1 to that selected range. The range will often be different every time, so it cannot be defined.
Here's what I have so far, it just works on a single active cell, I cannot get it to work on a range selection, because I do not know what to define or function to utilize.
My code Follows:
Sub Add()
ActiveCell.Value = ActiveCell.Value + 1
End Sub
The below code uses the built-in Paste Special Add feature to add 1 to every cell in the selected range.
Sub AddOneToSelection()
Dim rBlank As Range
If TypeName(Selection) = "Range" Then
'Put a '1' in an unused cell and copy it
Set rBlank = ActiveSheet.Cells.SpecialCells(xlLastCell).Offset(1, 0)
rBlank.Value = 1
rBlank.Copy
'Paste Special Add over the selection
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlAdd
'Get rid of the copied cell
rBlank.ClearContents
End If
End Sub
The benefit of this over looping is that Paste Special Add treats formulas and values differently and you don't have to code that part yourself.
The downside is you increase your UsedRange by one row, if that matters to you.
This should work for you:
Dim r, c As Range
Set r = Selection
For Each c In r
c.Value = "+1"
Next
This assumes that your cell formats will display "+1" instead of "1". You can set the format of your cells to "Text".
Related
Not a VBA expert at all and would really appreciate any help you experts could offer. I have a spread sheet with 10 columns (A-J) and a "control" column (M). Rows of data will be populated beginning with Row 9, with Row 8 being the header row. Row 7 contains specific formatting to be applied to rows if criteria in column M is met. For several reasons, I need to use VBA rather than conditional formatting. The code I have almost works. It worked on the initial row that met the criteria but none of the subsequent rows. Tried to fix the issue and now none of it works.
The specifics of my current code are:
rngSheet - the area of my spreadsheet with data that needs to be formatted.
rngColorTrigger - Column M containing the criteria. Criteria trigger is if the column value is 0.
rngColor - the cells containing the format to be copied and pasted (Row 7).
My current very-bad-doesn't-work code:
Private Sub Worksheet_SelectionChange2(ByVal Target As Range)
Dim rngColor As Range
Dim rngSheet As Range
Dim rngColorTrigger As Range
Set rngColor = Sheet1.Range("rngColor")
Set rngSheet = Sheet1.Range("rngSheet")
Set rngColorTrigger = Sheet1.Range("rngColorTrigger")
' Limit the copy area to the range for which the trigger is entered
If Not Intersect(Target, Sheet1.Range("rngColorTrigger")) Is Nothing Then
' Only trigger if the value entered is valid (Cell in Column M = 0)
For Each cell In Range("rngColorTrigger")
If cell.Value = 0 Then
Sheet1.Range("rngColor").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheet1.Range("rngSheet").Select
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Next cell
' Reset EnableEvents
Application.EnableEvents = True
End If
End Sub
I have very similar code that copy, cuts, and pastes content between pages based on a valid date being entered in a control column and it works fine...
I have a VBA macro which selects several cells based on if it contains conditional formatting. These cells won't all be in the same place on each sheet.
What I am looking for is a command to skip the activecell to the next cell in the range.
The same as pressing TAB on a highlighted range
At the moment I am using sendkeys, as below, however this is messy, and keeps adding Tab spaces in the next line of the vba code (hence the "____Loop")
ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Select
Do Until Recount = Count
Recount = Recount + 1
Application.SendKeys "{TAB}", True
Loop
Any advice would be appreciated
Here's how you can loop over the range:
Dim rng As Range, c As Range
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
For Each c In rng
c.Select
Next c
It's not clear what the aim of your code is though. What are Count and Recount?
Get a list of selected cells and loop through them
Sub loopThroughCells()
Dim r as Range
Set r = Application.Selection
For i = 0 to r.length
MsgBox(r.value)
Next i
End Sub
Suppose three cells with values 1, 2 and 3 are selected. On running the above macro, you will get message boxes with the values 1, 2 and 3 respectively.
If you only need the command for the tab button, just use the .offset(#of rows you want to offset, #of columns you want to offset). So once you know how to locate the cells you need, which you seem to already have, then you can just put.offset(0,1) to move one cell to the right.
I have a list of query words that I am submitting to a database (Column A) to generate a list of coded matches (Columns F-H). Column F is the original search word (so there is an exact match somewhere in Column A), Column G contains the match, and Column H contains the code for the match. What I need to do is take the query word in Column F and find its partner in Column A. Then I need to take the corresponding match and its code and paste it next to the original search term in Column A (in Columns B&C).
My problem here is getting the information pasted in the correct cell since the copy to and paste from locations change every time -- The list of coded matches in Columns F-H does NOT contain all of the terms in Column A.
I've been searching the internet and I can't seem to figure out what exactly I need to change to allow the paste function to work.
I have attached an image of a simplified version of my spreadsheet and a annotated version of the code I have been working with.
Sub FindMatch()
LastRow = Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 To LastRow
FindMe = Cells(i, 6).Value
Set FoundinList = Cells.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
If Not FoundinList Is Nothing Then
FoundinList.Select
ActiveCell.Offset(0, 1).Select
'At this point the cell I want the information pasted into is selected. Yay!
'Example: I am trying to find "abnormal digits" (F1) in Column A and paste
'G1:H1 into the appropriate cells in Columns B & C (In this case B15:C15)
'At this point in the code my cursor is on cell B15 - which is where I need it.
Range(Cells(i, 7), Cells(i, 8)).Copy
'This selects the appropriate range (G1:H1 in my example).
ActiveCell.Paste
'This is the problem string. I've tried naming the "ActiveCell" before initiating the copy
'string (ActiveCell.Name = "PasteHere") and then pasting into the named cell
'(Cells("PasteHere").Paste), but that gives me an invalid procedure call or argument on:
'Cells("PasteHere").Paste I've also tried pasting into a range:Range(Cells(PasteHere, 2)
', Cells(PasteHere, 3)).Paste -AND- using the formula that is created when you a record a
'macro (Application.CutCopyMode = False) but both of those give me an application
'/object-defined error.
End If
Next i
End sub
Thank you so much in advance for reading this post and helping me out.
My Spreadsheet
End Product
This vba uses the worksheet function vlookup.
Sub ahhn()
Dim ws As Worksheet
Dim cel As Range
Set ws = ActiveSheet
With ws
For Each cel In .Range(.Range("A1"), .Range("A1").End(xlDown))
cel.Offset(0, 1) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 2, 0), "")
cel.Offset(0, 2) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 3, 0), "")
Next
End With
End Sub
So I am writing a macro that sorts through a sheet by columns and clears cells containing certain kinds of data, specifically if they are numeric. My existing code does something like this to catch all number fields and clear them:
Selection.AutoFilter Field:=(i + 1), Criteria1:=">0"
Range(Cells(2, i), Cells(70000, i + 1)).Select
Selection.Clear
Worksheets("Sheet1").ShowAllData
Selection.AutoFilter Field:=(i + 1), Criteria1:="=0"
Range(Cells(2, i), Cells(70000, i + 1)).Select
Selection.Clear
Worksheets("Sheet1").ShowAllData
which works fine for cells which contain numbers in number format. Some of the cells contain numbers formatted as strings, ie what
="80"
would produce when typed into excel. I need to create a criteria for this autofilter that recognizes if a cell contains a number formatted as a string, but I dont know how, since the Criteria:=">0" and Criteria:="=0" are ignored by strings.
Another way :) I have commented the code but if you still have any questions, feel free to post back.
Sub Sample()
Dim rng As Range
'~~> Change this to the relevant sheet
With Sheet1
'~~> Change format of the column to number
'~~> This is an example for Col A
'~~> Change as applicable
.Columns(1).NumberFormat = "0"
'~~> Convert number stored as text to number
.Columns(1).Formula = .Columns(1).Value
'~~> Use Special Cells to select all cells containing numbers
On Error Resume Next
Set rng = .Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
rng.ClearContents
On Error GoTo 0
End With
End Sub
I don't think you can specify something so complicated as the criterion of AutoFilter.
However, here is a workaround:
Create a UDF like this:
Function IsTextNumeric(r As Range) As Boolean
If Application.IsText(r) And IsNumeric(r) Then
IsTextNumeric = True
Else
IsTextNumeric = False
End If
End Function
Programmatically create a Conditional Formatting for that range of cells. Conditional formatting allows you to specify a formula and use the true/false value of that expression to decide whether to apply formatting to the cell. The formula should just refer to the UDF. The Conditional Formatting to apply is cell coloring.
AutoFilter allows you to use cell coloring as a criterion.
I am not sure if what I want to achieve is possible. So here it is:
I got workbook with 2 sheets:
First sheet cointains raw data with employees and trainings they did or did not take (they could not come to the the training). Sheets cointains few columns like: name, special ID (different for every employee), 2 blank columns, presence (yes/no), and few more...
Second sheet will create report based on range and presence criteria.
Technically it's something like that:
Report sheet has list of employees, they will be filtered using autofilter. Those filtered employees will be checked if they were on 14 categories of trainings. Categories differs with range (ranges are known; with time ranges will be added or adjusted to newly added trainings).
My problem:
Is it possible to create vba code that will check if employee was on certain trainings (countif in certain range with condition: not present = do not count) and paste the value to certain cells? If it is could you give some advice on how to do that? I am not asking for ready code.
Trying to make it work but I stuck at this. Error at line "if cells.find...".
Sub Check()
MyRange = Range("A1", Selection.End(xlDown))
For Each MyCell In MyRange
With Range("pp2dni2007")
If Cells.Find(MyCell.Value) Is Nothing Then
Else
If ActiveCell.Value = ActiveCell.Offset(0, 3).Value Then
MyCell.Offset(0, 6).Value = 1
Else
MyCell.Offset(0, 6).Value = 0
End If
End If
End With
Next
End Sub
2nd edit, earlier code did infinite loop. Now I think if-statements reference to wrong range but not sure how to deal with it.
Sub Check()
Dim MyRange As Range, MyCell As Variant
Range("A1").Select
Set MyRange = Range(Selection, Selection.End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)
For Each MyCell In MyRange.Cells
With Range("pp2dni2007")
If .Cells.Find(MyCell.Value) Is Nothing Then
Else
If .Cells.Find(MyCell.Value).Value = .Cells.Find(MyCell.Value).Offset(0, 3).Value Then
MyCell.Offset(0, 6).Value = 1
Else
MyCell.Offset(0, 6).Value = 0
End If
End If
End With
Next
End Sub
Sample workbook: https://dl.dropboxusercontent.com/u/7421442/sample%20workbook%20(1).xls
Declare all your variables, e.g.,
Dim MyRange as Range, MyCell as Range.
Without declaration, MyCell is variant data type, and that is why you're getting an Object Required error. Then do:
For Each MyCell In MyRange.Cells
Inside the With block, you may want to use (note the . in front of Cells):
If .Cells.Find(MyCell.Value) Is Nothing Then
Further, you will probably need to revise what you're doing with ActiveCell, since this is never changing which cell is active, I'm not sure it would give you the expected results. It is always preferable to avoid relying on Active and Select methods (except for to use them as user-input). INstead, work with the range objects directly.