I Have an Issue to call Another Module (Run Time Error'424': Object Required). I have 2 Modules, Module 1 and Module 2. And Below is the code in Module 1 :
Private Sub test()
Dim Work As Worksheet: Set work= Sheets("S_BDN")
For i = 1 To 2
Set f = work.Range("A5", work.Range("A5").End(xlDown))
Set a = f.Find(i, LookIn:=xlValues)
If a.Offset(0, 10).Value = "January" Then
Call Module3.Proceed_B
End If
Next i
End Sub
And Below is the code in Module 2 :
sub Module3.Proceed_B()
If a.Offset(0, 6).Value = "A" Then
Debug.Print a.Offset(0, 4).Value
else
Debug.Print a.Offset(0, 5).Value
end if
end sub
All help is greatly appreciated. Thank you.
I can't see your "fixed" code or your sheet, so here are some generic suggestions for improvement:
Private Sub test()
Dim Work As Worksheet, f As Range, a As Range
Set work= Sheets("S_BDN")
Set f = work.Range("A5", work.Range("A5").End(xlDown)) 'take out of loop
For i = 1 To 2
Set a = Nothing
Set a = f.Find(i, LookIn:=xlValues, lookat:=xlWhole) 'provide *all* relevant parameters
If Not a Is Nothing Then 'make sure you got a match
If a.Offset(0, 10).Value = "January" Then
Proceed_B a 'pass a to the other sub
End If
End If
Next i
End Sub
sub Proceed_B(a As Range)
If a.Offset(0, 6).Value = "A" Then
Debug.Print a.Offset(0, 4).Value
else
Debug.Print a.Offset(0, 5).Value
end if
end sub
Related
I'm making a very easy application to insert names and some other info , and I'm getting a problem in the sub. I don't know what's happening , been a long time since I used vba ....
Private Sub button_Click()
Dim linha As Long
linha = Worksheets("FAMINHO_ESCOLAS").cell(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & linha).Value = boxname.Value
Range("B" & linha).Value = boxinstr.Value
Range("C" & linha).Value = boxescola.Value
Range("D" & linha).Value = boxtel.Value
Range("E" & linha).Value = boxemail.Value
End Sub
I'm getting error 438
I'm trying to return the values , when i press the "buttonright" it changes to the next data , and when i press buttonleft it shows me previous data and so on
Private Sub CommandButton1_Click()
GetFAMINHO_ESCOLASLastRow boxname1.Value, boxinstr1.Value, boxescola1.Value,
boxtel1.Value, boxemail1.Value
End Sub
Function GetFAMINHO_ESCOLASLastRow() As Range
Dim Target As Range
With Worksheets("FAMINHO_ESCOLAS")
Set Target = .Cells(.Rows.Count, 1).End(xlUp)
Set Target = Intersect(Target.EntireRow, Target.CurrentRegion)
End With
Set GetFAMINHO_ESCOLASLastRow = Target
End Function
linha is set to the last row but LR is the variable that is actually used for the last row.
linha = Worksheets("FAMINHO_ESCOLAS").Cell(Rows.Count, 1).End(xlUp).Row + 1
Cell( should be changes to Cells(.
linha = Worksheets("FAMINHO_ESCOLAS").Cells(Rows.Count, 1).End(xlUp).Row + 1
It would be better to qualify Rows.Count to the worksheet.
I prefer to write a separate sub routine to add the values. In this way, I can test the code without having to instantiate a userform.
Alternative Solution
Note: AddRowToFAMINHO_ESCOLAS will accept anywhere from 1 to 69 values.
Private Sub button_Click()
AddRowToFAMINHO_ESCOLAS boxname.Value, boxname.Value, boxinstr.Value, boxescola.Value, boxtel.Value, boxemail.Value
End Sub
Sub AddRowToFAMINHO_ESCOLAS(ParamArray Args() As Variant)
With Worksheets("FAMINHO_ESCOLAS")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(1, UBound(Args) + 1).Value = Args
End With
End Sub
AddRowToFAMINHO_ESCOLAS Demo
Addendum
This function will return the last row with values in column A.
Function GetFAMINHO_ESCOLASLastRow() As Range
Dim Target As Range
With Worksheets("FAMINHO_ESCOLAS")
Set Target = .Cells(.Rows.Count, 1).End(xlUp)
Set Target = Intersect(Target.EntireRow, Target.CurrentRegion)
End With
Set GetFAMINHO_ESCOLASLastRow = Target
End Function
You can test this function by entering the following code into the Immediate Window:
Application.Goto GetFAMINHO_ESCOLASLastRow
Response to Question Update
I changed things up a bit because the OP wants to write and retrieve the values.
Private Sub buttonleft_Click()
Dim Target As Range
Set Target = GetFAMINHO_ESCOLASLastRow
With Target
boxname.Value = .Cells(1, 1).Value
boxinstr.Value = .Cells(1, 2).Value
boxescola.Value = .Cells(1, 3).Value
boxtel.Value = .Cells(1, 4).Value
boxemail.Value = .Cells(1, 5).Value
End With
End Sub
Private Sub buttonright_Click()
Dim Target As Range
Set Target = GetFAMINHO_ESCOLASNewRow
With Target
.Cells(1, 1).Value = boxname.Value
.Cells(1, 2).Value = boxinstr.Value
.Cells(1, 3).Value = boxescola.Value
.Cells(1, 4).Value = boxtel.Value
.Cells(1, 5).Value = boxemail.Value
End With
End Sub
Function GetFAMINHO_ESCOLASLastRow() As Range
Dim Target As Range
With Worksheets("FAMINHO_ESCOLAS")
Set Target = .Cells(.Rows.Count, 1).End(xlUp)
Set Target = Intersect(Target.EntireRow, Target.CurrentRegion)
End With
Set GetFAMINHO_ESCOLASLastRow = Target
End Function
Function GetFAMINHO_ESCOLASNewRow() As Range
Set GetFAMINHO_ESCOLASNewRow = GetFAMINHO_ESCOLASLastRow.Offset(1)
End Function
I have the following:
Private Sub Worksheet_Activate()
If [E2] <> [G1] Then Range("H9:H44").Value = "Pendente"
End Sub
I need to include in the initial check whether the cells to be changed have a specific value.
I tried the following:
Private Sub Worksheet_Activate()
If [E2] <> [G1] And Range("H9:H44").Value = "Paga" Then Range("H9:H44").Value = "Pendente"
End Sub
That is, I need it to change only the cells that have the value "Paga" in that column.
What is the correct way to do this?
I need it to change only the cells that have the value "Paga" in that column.
Use .Replace so that it can replace all text in one go.
Option Explicit
Private Sub Worksheet_Activate()
If [E2] <> [G1] Then
Range("H9:H44").Replace What:="Paga", Replacement:="Pendente", LookAt:=xlWhole
End If
End Sub
This should do it.
With Sheet1 'Change as needed
If .Cells(2, 5).Value <> .Cells(1, 7).Value Then
Dim i As Long
For i = 9 To 44
If .Cells(i, 8).Value = "Paga" Then
.Cells(i, 8).Value = "Pendente"
End If
Next i
End If
End With
Try this, obviously change SheetName to your sheetname
For i = 9 to 44
x= Worksheets("SheetName").Cells(2,5)
y= Worksheets("SheetName").Cells(1,7)
z= Worksheets("SheetName").Cells(i,8)
If x<>y and z="Paga" then Worksheets("SheetName").Cells(i,8)="Pendente"
Next i
You can put this into a button (button below is called Replace) or use a macro
Private Sub Replace_Click()
Dim c As Range
For Each c In Range("H9:H44")
If c.Value = "Paga" Then
c.Value = "Pendente"
End If
Next c
End Sub
hope this helped
I am facing a problem in getting the sequence of the unique numbers(Serial number) when the userform is closed and opened later on. Firstly, when I fill the data in the userform everything is captured in the excel sheet perfectly with correct sequence; if I close the userform and run the code by filling the userform with new data the unique ID's are again starting from "1" but not according to the excel sheet row number which was previously saved.
Below is the code I tried:
Private Sub cmdSubmit_Click()
Dim WB As Workbook
Dim lr As Long
Set WB = Workbooks.Open("C:\Users\Desktop\Book2.xlsx")
Dim Database As Worksheet
Set Database = WB.Worksheets("Sheet1")
eRow = Database.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lr = Database.Range("a65536").End(xlUp).Row
With Sheets("Sheet1")
If IsEmpty(.Range("A1")) Then
.Range("A1").Value = 0
Else
Database.Cells(lr + 1, 1) = Val(Database.Cells(lr, 1)) + 1
End If
End With
Database.Cells(eRow, 4).Value = cmbls.Text
Database.Cells(eRow, 2).Value = txtProject.Text
Database.Cells(eRow, 3).Value = txtEovia.Text
Database.Cells(eRow, 1).Value = txtUid.Text
Call UserForm_Initialize
WB.SaveAs ("C:\Users\Desktop\Book2.xlsx")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
Private Sub UserForm_Initialize()
With txtUid
.Value = Format(Val(Cells(Rows.Count, 1).End(xlUp)) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
In this image if you see unique id's are repeating 1 and 2, but I need as 1,2,3,4....
I think this is where the issue is coming from. You need to re-calculate the last row every time the user form is Initialized.
Private Sub UserForm_Initialize()
Dim ws as Worksheet: Set ws = Thisworkbook.Sheets("Database")
With txtUid
.Value = Format(ws.Range("A" & ws.Rows.Count).End(xlUp) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
It's always risky to use row numbers or [max range value +1] as a sequence number.
Safer to use something like a name scoped to the worksheet, which has a value you can increment. Then the sequence is independent of your data.
E.g.
Function GetNextSequence(sht As Worksheet) As Long
Const SEQ_NAME As String = "SEQ"
Dim nm As Name, rv As Long
On Error Resume Next
Set nm = sht.Names(SEQ_NAME)
On Error GoTo 0
'add the name if it doesn't exist
If nm Is Nothing Then
Set nm = sht.Names.Add(Name:=SEQ_NAME, RefersToR1C1:="=0")
End If
rv = Evaluate(nm.Value) + 1
nm.Value = rv
GetNextSequence = rv
End Function
I created a userform that will autofill in all the information using the ID# but I cant pull the source from the specific folder, workbook and range.
Here is my code:
Private Sub TextBox4_Change()
Dim rSource As Range
If Not r Is Nothing Then
'// Get value in cell r.row, column 2 into textbox2
TextBox2.Text = Sheet1.Cells(r.Row, 4).Value
ComboBox3.Value = Sheet1.Cells(r.Row, 6).Value
ComboBox4.Value = Sheet1.Cells(r.Row, 8).Value
ComboBox5.Value = Sheet1.Cells(r.Row, 9).Value
End If
End sub
Thank you!
See my answer in the code below (explanation inside the code as comments):
Option Explicit
Private Sub TextBox4_Change()
Dim wb As Workbook
Dim rSource As Range
' === first set the Workbook object ===
' if the workbook (Excel file) is already open >> use the line below
Set wb = Workbooks("Request ID.xlsm")
' if its close, then use the alternative line below
Set wb = Workbooks.Open("\\Path\")
' now use the Find function
Set rSource = wb.Worksheets("Sheet1").Range("A:A").Find(What:=TextBox4.Text, LookAt:=xlWhole, MatchCase:=False)
If Not rSource Is Nothing Then '<-- you need to use the same Range variable you used for the Find
'// Get value in cell r.row, column 2 into textbox2
TextBox2.Text = Sheet1.Cells(rSource.Row, 4).Value
ComboBox3.Value = Sheet1.Cells(rSource.Row, 6).Value
ComboBox4.Value = Sheet1.Cells(rSource.Row, 8).Value
ComboBox5.Value = Sheet1.Cells(rSource.Row, 9).Value
End If
End Sub
The code below works fine when I manually update column I. What I need is to know if there is a way to still have this code work when I have column I updated by a formula.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("I3:I30"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -1).ClearContents
Else
With .Offset(0, -1)
.NumberFormat = "m/d/yy h:mm"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
Worksheet_Change does not fire in responce to a formula update.
See Excel help for Worksheet_Change
Occurs when cells on the worksheet are changed by the user or by an external link.
You could maybe achieve what you want with the Worksheet_Calculate event.
Assuming you want to put a time stamp next to the cells when those vall values change, try this (in addition to your Change event).
Note the use of the Static variable to track previous values, since Calculate event does nopt provide a Target parameter like Change does. This method may not be robust enough since Static's get reset if you break vba execution (eg on an unhandled error). If you want it more robust, consider saving previous values on another (hidden) sheet.
Private Sub Worksheet_Calculate()
Dim rng As Range, cl As Range
Static OldData As Variant
Application.EnableEvents = False
Set rng = Me.Range("I3:I30")
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For Each cl In rng.Cells
If Len(cl) = 0 Then
cl.Offset(0, -1).ClearContents
Else
If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
With cl.Offset(0, -1)
.NumberFormat = "m/d/yy h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub
Update
Tested routine on sample sheet, all works as expected
Sample file contains the same code repeated on 25 sheets, and range to time stamp is 10000 rows long.
To avoid repeating the code, use the Workbook_ events. To minimise run time use variant arrays for the loop.
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Range
Dim NewData As Variant
Dim i As Long
Static OldData As Variant
Application.EnableEvents = False
Set rng = Sh.Range("B2:C10000") ' <-- notice range includes date column
NewData = rng
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For i = LBound(NewData, 1) To UBound(NewData, 1)
If Len(NewData(i, 1)) = 0 And Len(NewData(i, 2)) > 0 Then
rng.Cells(i, 2).ClearContents
Else
If NewData(i, 1) <> OldData(i, 1) Then
With rng.Cells(i, 2)
.NumberFormat = "m/d/yy -- h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Activate date population on cell change
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Sh.Range("B2:B10000"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
'Populate date and time in column c
With .Offset(0, 1)
.NumberFormat = "mm/dd/yyyy -- hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub