Correcting a selected range - excel

I have a sheet where the user selects a non-contigious range of cells (ie E4, F6, G7) which I want to be able to convert into (A4, A6, A7) keeping the row number but changing the column. I want to only return a single value however if they select more than one cell in the same row or worse still select the entire row. I am a little out of practice with my VBA and can't figure this one out

.Offset and .Resize do not work with non-continous ranges. But dou can use some tricks to get that done.
The idea is to convert the user's selection into an entire row selection and intersect that with the range of column A. The result is the intersecting cells in column A with the originally selected rows.
Option Explicit
Public Sub SelectAInSelectedRows()
Dim UserSelection As Range
Set UserSelection = Selection.EntireRow ' make user's selection entire row
Dim SelectARange As Range
Set SelectARange = Intersect(UserSelection.Parent.Columns("A"), UserSelection) ' intersect the rows with column A
' select the resulting range in column A
SelectARange.Select
End Sub

Put this into a relevant worksheet module.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not (Intersect(ActiveSheet.Columns(1), Target) Is Nothing) Then Exit Sub
ActiveSheet.Cells(Target.Row, 1).Value2 = Target.Value2
End Sub
You can also check if the output cell is not empty, then change

Related

Put first cell's value depend on which row is selected, into another cell

i need to write a cell value in other cell by clicking a range of cells as below:
my range is between b1:x30 and i want every time i click on these selection range then the value of b1 to b30 (depending which row selected) will write in cell z1
i tried to write a code as below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B1:X30")) Is Nothing Then
If Intersect(Target, Range("B1:X30")) Then
Worksheets("Order Sheet").Range("Z1").Value = .Range("B1:B30").Value
End If
End If
End If
End Sub
i know this code is not complete yet and i need to help to complete.

Hide all Rows except matching value

I'm working with some data in excel spanning B9:AJ1108 - so multiple rows and columns. I am looking to hide all rows except where the value in column B matches the number in cell C5.
I've tried multiple and can only just about get everything to hide but the unhiding is the issue. I understand how to hide all and how to unhide all. What I need help with is how to hide all and then unhide if something matches the value in C5.
Code so far:
Private Sub CommandButton2_Click()
Worksheets("Employee information").Range("B9:B1108").Rows.Hidden = False
End Sub
Private Sub CommandButton1_Click()
Worksheets("Employee information").Range("B9:B1108").Rows.Hidden = True
'Need to put in the argument to search for C5 value
End Sub
I would also like this to be button controlled but I don't know if that is a case of creating a module or just code within the sheet?
For unhiding the rows you can use "Rows.EntireRow.Hidden = False"
If you want to use a button for the macro to get executed, create a button and excel will ask you which macro you want to get when you click the button.
value= Worksheets("Employee information").cells(5,3).value
That will give you the value of the cell C5, now you need to go through the rows and look for this value.
Hide Rows Not Containing Criteria in Column
Private Sub CommandButton1_Click()
With Worksheets("Employee information")
' Define Criteria (restrict to numbers).
Dim Criteria As Variant
Criteria = .Range("C5").Value
If Not IsNumeric(Criteria) Then
Exit Sub
End If
' Define Criteria Range.
Dim rng As Range
Set rng = .Range("B9:B1108")
End With
' Declare additional variables.
Dim hRng As Range ' Hide Range
Dim cel As Range ' Current Cell (in Source Range)
Dim CurVal As Variant ' Current Value (of Current Cell in Source Range)
' Create a union (Hide Range) of all the cell ranges
' that do not contain Criteria.
For Each cel In rng.Cells
' Evaluate Current Value.
CurVal = cel.Value
If IsNumeric(CurVal) Then
If CurVal = Criteria Then
GoTo NextCell ' Match found: do nothing.
End If
End If
' Match not found: add Current Cell to Hide Range.
If Not hRng Is Nothing Then
Set hRng = Union(hRng, cel)
Else
Set hRng = cel
End If
NextCell:
Next cel
' Hide rows of Hide Range.
If Not hRng Is Nothing Then
hRng.Rows.Hidden = True
End If
End Sub

Add a Value Automatically to a Cell Based on Another Cell

I want to add a value to a cell based on another with VBA but I'm not sure how. I already searched on internet about it but can't find anything.
I have a table, and on the Column C, if any cell contains the text "MAM" (because it might have MAM-565), then change the value from Cell A to "Wrong", but if it contains "NAC", then change value to "Correct". It should be in the same row as the text found.
Also, I want to add the date automatically to cell E every time Cell in D is filled.
This the code I have already:
Private Sub Worksheet_Change(ByVal Target As Range)
'Add Issue Type'
Dim Code As Range
Set Code = Range("C2:C100000")
For Each Cell In Code
If InStr(1, Cell, "NAC") Then
Range("A2:A10000").Value = "Correct"
ElseIf InStr(1, Cell, "MAM") Then
Range("A2:A10000").Value = "Wrong"
End If
Next
End Sub
This how my table looks like:
Table
Thanks in advance guys :)
To automatically add the datestamp:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range
Set rng = Intersect(Target, Me.Range("D:D"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell as Range
For Each cell in rng
If Not IsEmpty(cell) Then ' don't do anything if cell was cleared
cell.Offset(,1).Value = Date
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
As far as the Correct/Wrong, this can easily be done with a formula (ISNUMBER(SEARCH(...)). I don't see the need for VBA here.
Even better, create a table using Ctrl+T. Excel will automatically add the formula in column A in new rows.

How to access another cells on the same row based on cell change?

I change the value in the cell and I would like to print/get the cell on the same row but on different column. Here is the example:
Col1 Col2
a
b 10
c
When I add 10 to the third row Col2, I would like to see a message box with value on Col1 third row, which is "b".
Rows index shouldn't be limited to 3 as in the example.
Edited: I will add some value on any cell under Col2, and I would like a macro to add this value to the left column automatically.
Use the Worksheet.Change event in your desired worksheet. It triggers on every change of any cell. You can use the Application.Intersect method to limit your code to trigger on changces in column 2.
Finally you can use the Range.Offset property to move from the cell that was changed to another column by setting the ColumnOffset parameter. Negative values move left positive right of the current cell.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Columns(2)) 'check if the change was in column 2
If Not AffectedRange Is Nothing Then 'run the code only if column 2 was changed
Dim Cell As Range
For Each Cell In AffectedRange 'run this code for every cell in column 2 that was changed
If Cell.Value = 10 Then 'test if the cell was changed to 10
MsgBox Cell.Offset(ColumnOffset:=-1).Value 'return the value of the cell one left (-1) of the cell that was changed
End If
Next Cell
End If
End Sub
Cells(yourRange.Row, anyColumnNumberYouWish)
or
Cells(Range("B3").Row, 1)

How do I change a cell value dependant on a drop-down event?

I have almost found the answer to this in previous post, but not quite.
The scenario is as follows.
Column A contains values, based on a drop down list.
When I change a value - on any row in column A - I want the current date to be written into to the corresponding row in column C. The date must not change when I save and re-open the file at a later point, i.e. the =TODAY() function won't do it.
The user might change a multiple values on different rows in column A before exiting and saving the file.
Thankful for any input.
MÃ¥rten.
This should meet your needs, paste this vba code into the Microsoft Excel Object for the worksheet you desire (so if this is for Sheet1, paste it into Sheet1):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim controlRng, nRng As Range
'This will be the entire range of drop downs you have, I've set it to be the entire column A, if that's not suitable then change it to a set range
Set controlRng = Range("A:A")
Set nRng = Intersect(controlRng, Target)
If nRng Is Nothing Then Exit Sub
If Target.Value <> "" Then
Target.Offset(0, 2).Value = Now
End If
End Sub

Resources