I am trying to use an ActiveCell.Offset function. I am slightly confused to code using Column A as my base.
I wouldn't want to input as new row. I would want to start from number 1 instead of skipping to an empty row.
My code is as below.
Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = Range("A2:A2")
If TextBox1.Value = "" Then
If MsgBox("Form is not complete. Do you want to continue?", vbQuestion+vbYesNo) <> vbYes Then
Exit Sub
End If
End If
ActiveCell.Offset(0, 1) = TextBox1.Value
ActiveCell.Offset(0, 2) = TextBox2.Value
ActiveCell.Offset(0, 5) = TextBox3.Value
ActiveCell.Offset(1, 0).Select
End Sub
You seem to be setting a range
Set rng = Range("A2:A2")
and not using rng anywhere in the sub. In addition you seem to be basing your offset on the ActiveCell but not having a clear ActiveCell selected in the sub (you could be selecting it outside the routines of course) which leads me to suspect that this 'rng' is your desired Active cell. If this is the case then you will need to make rng the ActiveCell by activating the cell.
Related
I've created a userform where I have a "save" button which copies all of the values in the text and comment boxes to the workbook. I've included the code below but I'm wondering if there is a more efficient way of achieving this without using all the lines of code:
prod = Range("d4").Value - 1
Sheets("Latest").Select
ActiveCell.Offset(prod, 0).Select
ActiveCell.Value = 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Application.UserName
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Now()
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = age.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = sex.Value
...
...
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = height.Value
I also have the same issue when loading the userform with pre-defined values. I literally have to have a line for every textbox that is to be populated:
Controls("age").Value = Format(Range("age"), "standard")
Controls("share").Value = Format(Range("share"), "percent")
Controls("salary").Value = Format(Range("salary"), "#,###")
...
...
Controls("share2").Value = Format(Range("share2"), "percent")
the code works but it just seems like it's unnecessarily long.
The trick is to use the same name for the cells as for the controls on the user-form.
The name-syntax should help to distinguish the names from other names on the sheet, eg. input_xxx.
This is a simplified solution which you have to adjust to your needs:
Sub showForm()
'assumption all cells/controls have name with syntax input_xxx
writeValuesToUserForm
UserForm1.Show vbModal
writeValuesToSheet
End Sub
Public Sub writeValuesToUserForm()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Latest")
Dim n As Name
For Each n In ThisWorkbook.Names
If n.Name Like "input_*" Then
UserForm1.Controls(n.Name).Value = n.RefersToRange
End If
Next
End Sub
Sub writeValuesToSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Latest")
Dim n As Name
For Each n In ThisWorkbook.Names
If n.Name Like "input_*" Then
n.RefersToRange.Value = UserForm1.Controls(n.Name).Value
End If
Next
End Sub
I have a worksheet change macro that highlights the first 8 cells in a row if the last cell contains the word "Cancelled". This works fine. However the word cancelled is in a drop down menu and if you accidently select it the macro kicks in. If you change to another word in the same cell, I would like it to remove the condition and go back to normal. Can someone help me out with this. Im sure it is something simple that I'm missing.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
If UsedRange.Rows.Count > 0 Then
If Trim(Cells(Target.Row, Target.Column)) <> "" And _
UCase(Cells(Target.Row, Target.Column)) = "CANCELLED" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = vbRed
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Font.Color = vbWhite
ElseIf Trim(Cells(Target.Row, Target.Column)) <> "" And _
UCase(Cells(Target.Row, Target.Column)) <> "CANCELLED" Then
Cells.FormatConditions.Delete
End If
End If
ErrHandler:
'
End Sub
You don't "apply" and "remove". You "apply" in both cases, just that you apply different colours.
Private Sub Worksheet_Change(ByVal Target As Range)
Const TriggerClm As Long = 8 ' change to suit
Dim TriggerRng As Range
Dim TargetRng As Range
Dim IntCol As Long
' Here the first row is 2, presuming row 1 contains captions
Set TriggerRng = Range(Cells(2, TriggerClm), Cells(Rows.Count, TriggerClm).End(xlUp))
If Not Application.Intersect(Target, TriggerRng) Is Nothing Then
With Target
Set TargetRng = Range(Cells(.Row, TriggerClm - 7), Cells(.Row, TriggerClm))
If StrComp(CStr(.Value), "cancelled", vbTextCompare) Then
TargetRng.Interior.Pattern = xlNone
TargetRng.Font.Color = vbBlack
Else
TargetRng.Interior.Color = vbRed
TargetRng.Font.Color = vbWhite
End If
End With
End If
End Sub
Observe that I reasoned that a change can only be triggered if a cell in the 8th column is changed because only that cell is either "Cancelled" or not. My code's logic deviates from yours in this respect.
I am beginner at VBA, I am stuck plz help. In this image(linked at the end of paragraph), I am trying to insert line above the cells which contains different name than the name of upper cell. Plz tell me if there is an easier way to do this or how to apply the given if else condition to whole "G" Column...
Still I am adding my code below if you don't need the image...
Sub ScanColumn()
'Application.ScreenUpdating = False
Dim varRange As Range
Dim currentCell As String
Dim upperCell As String
Dim emptyCell As String
currentCell = ActiveCell.Value
bottomCell = ActiveCell.Offset(1, 0).Value
emptyCell = ""
Dim intResult As Integer
intResult = StrComp(bottomCell, currentCell)
Dim emptyResult As Integer
emptyResult = StrComp(currentCell, emptyCell)
'I want to apply below condition to whole G column in used range
If emptyResult = 0 Then
ActiveCell.Select
ElseIf intResult = 0 Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
End Sub
Here you have, just call the function "evaluateColumn" and pass the parameters, as example the "trial" sub.
Function evaluateColumn(column As String, startRow As Long, wsh As Worksheet)
Dim lastRow As Long
lastRow = wsh.Range(column & wsh.Rows.Count).End(xlUp).Row
Dim i As Long: i = startRow
Do While i < lastRow
If wsh.Cells(i, column).Value <> wsh.Cells(i + 1, column).Value And wsh.Cells(i, column).Value <> "" And wsh.Cells(i + 1, column).Value <> "" Then
wsh.Range(column & i + 1).EntireRow.Insert shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
i = i + 1
lastRow = lastRow + 1
End If
i = i + 1
Loop
End Function
Sub trial()
evaluateColumn "G", 2, ThisWorkbook.Worksheets("Sheet2")
End Sub
As you can see from the difference between my answer and the one below, your question isn't entirely clear. My code is an event procedure. It will run automatically, as you select a cell within the used range of column G.
If the value of the selected cell is the same as the cell below it the next row's cell will be selected.
If there is a value in either of the two cells, a blank row will be inserted and that row's cell selected. (If you want another row enable the row below the insertion.)
If either of the above conditions are true, do nothing and proceed with the selection the user made.
In order to let this code work it must be installed in the code sheet of the worksheet on which you want the action. It will not work if you install it in a standard code module, like Module1.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TriggerRange As Range
Dim Off As Long ' offset from Target for selection
' if more than one cell is selected choose the first cell
If Target.Cells.CountLarge > 1 Then Set Target = ActiveCell
Set TriggerRange = Range(Cells(2, "G"), Cells(Rows.Count, "G").End(xlUp))
' this code will run only if a cell in this range is selected
' Debug.Print TriggerRange.Address(0, 0)
If Not Application.Intersect(Target, TriggerRange) Is Nothing Then
Application.EnableEvents = False
With Target
If .Value = .Offset(1).Value Then
Off = 1
ElseIf WorksheetFunction.CountA(.Resize(2, 1)) Then
Rows(.Row).Insert
' Off = 1 ' or -1 to change the selection
End If
.Offset(Off).Select
End With
Application.EnableEvents = True
End If
End Sub
I would like to create a script, I got two (2) workbooks and they are kind of related, on the first one I would like to activate a sheet find and offset one cell and select all the info. and in case the cell contains a "yes" in the new one would paste "Yes" instead of all the info. in the previous workbook.
Sub test2()
Dim SingleCell As Range
Dim Listcells As Range
Application.ScreenUpdating = False
Workbooks("OLD CAD").Sheets("Contract History-Modifications").Activate
ActiveSheet.Range("B:B").Find(" CM Name/Number", MatchCase:=True).Select
Range(ActiveCell.Address).Offset(2, 0).Select
Range(ActiveCell.Address, Range(ActiveCell.Address).End(xlDown)).Select
Selection.Offset(0, 13).Select
'ActiveSheet.Range(Selection.Address)
'MsgBox (Selection.Address)
Set Listcells = Range(Selection.Address)
For Each SingleCell In Listcells
'Select Case True
' Case Is = InStr(1, (SingleCell.Value), "Yes") > 0
If InStr(1, (SingleCell.Value), "Yes") > 0 Then
Workbooks("NEW CAD").Sheets("Contract History-Modifications").Activate
ActiveSheet.Range("i:j").Find("A. Did the CM change the price of the transaction?", MatchCase:=True).Activate
Range(ActiveCell.Address).Offset(1, 0).Select
Range(ActiveCell.Address).Value = "Yes"
ActiveCell.Offset(1, 0).Select
End If
'End Select
Next SingleCell
End Sub
i have a cell (A1) linked to real-time data (=Tickers!Z12). i want to capture all of the price range in a five minute period. my issue is i'm trying to use the Worksheet_Change method but it wont update when the values change if the cell (A1) is formulated. it works fine if i manually change the values. but i need to capture values that are being generated by the formula and then copy & paste the values in column B everytime the values change. here's what i have so far.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Range("A1").value <> Range("B2").value Then
Range("A1").Select
Selection.Copy
With ActiveSheet
LastRow = .Cells(.rows.Count, "B").End(xlUp).row + 1
.Cells(LastRow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
End If
Application.CutCopyMode = False
Application.EnableEvents = True
End Sub
Try using the Worksheet_Calculate event.
Also, I'm not sure you want to compare A1 to B2. Logic dictates you should be comparing it to the last cell in column B.
Also, using Activesheet is not a good idea, as the recalculation can happen when you are on any other sheet, and you don't want to write values on random worksheets.
And one more thing: don't use copy-paste ina macro. Just make .Value=.Value.
Private Sub Worksheet_Calculate()
Dim lngLastRow As Long
On Error Goto SkipAllThis
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Source") 'or whatever sheet has your code and stores your values
lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
If .Range("A1").Value <> .Cells(lngLastRow, 2).Value Then
.Cells(lngLastRow + 1, 2).Value = Range("a1").Value
End If
End With
SkipAllThis:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
DRS,
Implement the sleep function as:
Declaring & Calling The Sleep API
Then afterward, capture your value. Just note the API is in milliseconds.
G.