VBA for column "I" value of the ActiveCell row - excel

Goodnight,
I have this code that identifies the ActiveCell and sends the value of that cell to "I6". With the change of the values ​​that appear in "I6", the corresponding photographs of the students will change.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("I6").Value = ActiveCell.Value
End Sub
With this code, I get the value of the cell to appear in "I6" whenever I click on a cell in the table. As long as i click on the "I" column where the student numbers are, everything is fine.
The problem appears when I click on any other table cell ("I14:X43") outside this "I" column.
I needed the code to always identify column "I" (I4:I43) of the active cell row.
Thus, whenever you are entering a record in any cell of the table ("I14:X43"), the code will identify the column "I" of that line and its value (student number). Identifying the value found in column "I" of the active cell row, it will appear in "I6", as it is in this formula and was changing the students' photographs.
At this moment, when I write a value inside the table, it will be this value that will appear in "I6" carrying a photograph that corresponds to the value that was registered/written and not to the number of the student of the line where I am.
However, a friend helped me with this code which works for what I intended but only up to column "Z".
Sub_ Selectionchange
Dim x As String
Dim and As String
x = ActiveCell.Address(0, 0)
y = WorksheetFunction.Replace(x, 1, 1, "=I")
Range("I6").Value = y
End Sub
Clicking after that "Z" column, the code stops working and 0 appears in the "I6" column.
Can anyone help, please?
Try to getting a vba code to send the column "I" value of the ActiveCell row to cell "I6"

A Worksheet Selection Change: Trigger Worksheet Change
Option Explicit
Private Const ID_CELL As String = "I6"
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Me.Range(ID_CELL), Target) Is Nothing Then Exit Sub
' Your code for showing the student's image.
MsgBox "Like showing student's image for ID number " _
& CStr(Me.Range(ID_CELL).Value) & ".", vbInformation
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const ID_RANGE As String = "I14:I43"
Dim srg As Range: Set srg = Me.Range(ID_RANGE)
Dim rrg As Range: Set rrg = srg.EntireRow ' srg.EntireRow.Columns("I:X")
Dim irg As Range: Set irg = Intersect(rrg, Target)
If irg Is Nothing Then Exit Sub
Dim sCell As Range: Set sCell = Intersect(srg, irg.EntireRow).Cells(1)
Dim dCell As Range: Set dCell = Me.Range(ID_CELL)
' If not equal, write, triggering the Worksheet Change event.
If sCell.Value <> dCell.Value Then dCell.Value = sCell.Value
End Sub

Use the ActiveCell row and always use 9 => "I" column with Cells to get the value in column I in the same row of ActiveCell
Sub_ Selectionchange
Dim x As String
Dim and As String
Dim row as long
row = ActiveCell.row
If row >12 and row <44 Then
Range("I6").Value = cells(row,9).value
End If
End Sub

Related

Change Cell formatting based on value

How do I automatically format a cell as I enter a value?
I divided the numbers into 3 categories: percentages, small numbers (-1000 - 1000), and large numbers.
I want percentages to be displayed with 2 decimals and the % sign.
Small numbers with 2 decimals as well.
And large numbers rounded to nearest integer, with thousands separators.
I want the code to reformat the cell if the cell value changes. For instance, if I change a cell with value "50,000", to 60%, then, it should be displayed as "60.00%".
Code I have so far applies formatting on existing cell values.
Sub myNumberFormat()
Dim cel As Range
Dim selectedRange As Range
Set selectedRange = Selection
For Each cel In selectedRange.Cells
If Not CStr(cel.Text) Like "*%*" Then
If Not IsEmpty(cel) Then
If cel.Value < 1000 And cel.Value > -1000 Then
cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)"
Else
cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)"
End If
End If
Else
cel.NumberFormat = "0.00%"
End If
Next cel
End Sub
A Worksheet Change: Apply Cell Formatting
This is a simple example for a single column, in this particular case, the range from A2 to the bottom-most cell in column A. But you can choose any reasonable cell address. In whatever cell you manually change (enter, copy/paste, or write using VBA) its value, the cell will be formatted according to your 'rearranged' procedure ApplyMySpecialNumberFormat.
Note that this works automatically, just copy the codes to the appropriate modules and start entering data into the cells of the range to see it work.
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Define constants.
Const FirstCellAddress As String = "A2" ' adjust to any reasonable cell
' Reference the source column range e.g. 'A2:ALastWorksheetRow'.
Dim srg As Range '
With Me.Range(FirstCellAddress)
Set srg = .Resize(Me.Rows.Count - .Row + 1)
End With
' Reference the cells of the source range that have changed.
Dim irg As Range: Set irg = Intersect(srg, Target)
If irg Is Nothing Then Exit Sub ' no source range cells changed; exit
' At least one cell was changed:
ApplyMySpecialNumberFormat irg
End Sub
Standard Module e.g. Module1
Option Explicit
Sub ApplyMySpecialNumberFormat(ByVal rg As Range)
Dim cel As Range
For Each cel In rg.Cells
If CStr(cel.Text) Like "*%*" Then
cel.NumberFormat = "0.00%"
Else
If VarType(cel) = vbDouble Then ' is a number
If cel.Value < 1000 And cel.Value > -1000 Then
cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)"
Else
cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)"
End If
End If
End If
Next cel
End Sub

Update corresponding cell in a column based on row value using vba

I enter data on sheet1 in various rows and columns. I am trying to get a date to display in sheet2 each time i enter a value in sheet1.
This is what i have in Sheet1:
`Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I7:NF1000")) Is Nothing Then
Sheet2.Range("E7:E") = Now
End If
End Sub`
The code works but the issue is that whenever a cell in Sheet1 range is updated it enters the date in all the cells in column E in Sheet2.
How do i get it to only display date in the corresponding cell on sheet2.
Eg. if i enter a value in I8 on Sheet1, i want the date to come across in E8 on sheet2.
I can do it with each individual row but that would mean i would need to copy the If Not function a 1000+ times to cover all the rows.. see below:
`If Not Intersect(Target, Range("I8:NF8")) Is Nothing Then
Sheet2.Range("E8") = Now
End If
If Not Intersect(Target, Range("I9:NF9")) Is Nothing Then
Sheet2.Range("E9") = Now
End If`
and so on.... is there a way to avoid this and have a simpler code that will do this without me having 1000+ lines on code..
A Worksheet Change: Time Stamp in Another Worksheet
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim srg As Range: Set srg = Range("I7:NF1000")
Dim irg As Range: Set irg = Intersect(srg, Target)
If irg Is Nothing Then Exit Sub
Set irg = Intersect(irg.EntireRow, Columns("E"))
Dim TimeStamp As Date: TimeStamp = Now
Dim arg As Range
For Each arg In irg.Areas
Sheet2.Range(arg.Address).Value = TimeStamp
Next arg
End Sub

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

Find All Empty Cells in Column and Paste Formula in them

I'm close to what i want to do but not sure if I'll have to change method completely to get this done.
The below code works almost completely. I want to find all empty cells in range: C2:C120 and enter a formula from another worksheet: Worksheets("Sheet2").Range("F57").
It finds empty cells but it copies the text in the F57 cell, which is #N/A at the moment, not the formula. The formula is =VLOOKUP(D57,'[Example.xlsx]Sheet1'!$A$2:$D$37,2) but I can't enter it directly into the code as it will always look for D57, not dynamically.
Any help is hugely appreciated, hopefully it's a simple fix.
Private Sub CommandButton3_Click()
Dim ws As Worksheet
Dim rng As Range
Set ws = Worksheets("Sheet1")
For Each rng In ws.Range("C2:C120")
If IsEmpty(rng) Then
rng.Formula = Worksheets("Sheet2").Range("F57")
End If
Next
End Sub
I couldn't find an answer for this specifically though I'm sure i've come accross one before.
If I understand correctly, the following should work.
In your loop you can reference the rng row number in your formula.
You could use (note, not tested):
For Each rng In ws.Range("C2:C120")
If IsEmpty(rng) Then
rng.Formula = "=VLOOKUP(D" & rng.Row & ",'[Example.xlsx]Sheet1'!$A$2:$D$37,2)"
End If
Next rng
This uses the Row property of the Range object, which is the row number of whatever cell you are accessing in your loop in each iteration, and uses it as the row number for your D57 part of your formula (per your posted formula).
Update Data From Different Workbook
Adjust the constants in updateCustomers.
The Code
Sheet1 (or wherever you have CommandButton3)
Option Explicit
Private Sub CommandButton3_Click()
updateCustomers
End Sub
Module1
Sub updateCustomers()
' Source
Const wbsName As String = "Example.xlsx"
Const srcName As String = "Sheet1"
Const srcAddr As String = "A2:B37"
' Target
Const tgtName As String = "Sheet1"
Const LookupCol As String = "A"
Const tgtAddr As String = "C2:C120"
' Ranges
Dim src As Range
Set src = Workbooks(wbsName).Worksheets(srcName).Range(srcAddr)
Dim tgt As Range
Set tgt = ThisWorkbook.Worksheets(tgtName).Range(tgtAddr)
' The Loop
Dim cel As Range
For Each cel In tgt.Cells
If IsEmpty(cel) Then
On Error Resume Next
cel.Value = WorksheetFunction _
.VLookup(tgt.Parent.Cells(cel.Row, LookupCol).Value, src, 2, False)
On Error GoTo 0
End If
Next
MsgBox "Customers updated.", vbInformation, "Success"
End Sub

VBA Code for current cell works for cell underneath when pressing enter, not current cell

First of all, I've not heard of VBA before yesterday, but not a total noob in other languages (Python, Java). Put this piece of code together with help from the internet. The idea is that when you enter a string in a cell in worksheet "B" (in range B1:B200), it finds that string in worksheet "A" (in column A), takes the value that is next to it on the right side, takes that value and prints in next to the string in worksheet "B".
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B1:B200")) Is Nothing Then
Dim xlRange As Range
Dim xlCell As Range
Dim xlSheet As Worksheet
Dim valueToFind
valueToFind = Target.Value
Set xlSheet = ActiveWorkbook.Worksheets("A")
Set xlRange = xlSheet.Range("A:A")
For Each xlCell In xlRange
If IsEmpty(xlCell) = True Then
MsgBox("Not found!")
Exit For
End If
If xlCell.Value = valueToFind Then
Target.Offset(0, 1) = xlCell.Offset(0, 1)
MsgBox ("Found!")
Exit For
End If
Next xlCell
End If
End Sub
It almost works, except from the part that when you input a value in cell B1 and you press enter, the cursor goes to B2 and apllies the code there. So when I input a string in B1 that is in worksheet "A", it gives me "Not found!", because B2 is empty.
Is there an easy fix for this?
Have a nice day

Resources