Im trying to get the row number back after matching the user input via Vlook up this is meant to be used in the process of pulling items into a custom userform for editing. How should i return this Row number.
Here is my code for this.
Sub Sheet1_Button2_Click()
Dim Vall As String
Vall = InputBox("Enter Refernce #", Find & Edit)
Vall2 = Application.VLookup(Vall, 11, K1)
MsgBox "found" & Application.Row(Vall2)
Vall3 = Vall2.Rows
UserForm1.TextBox1 = Sheets(1).Range("A" + Vall3).Text
UserForm1.TextBox2 = Sheets(1).Range("B" + Vall3).Text
UserForm1.TextBox3 = Sheets(1).Range("C" + Vall3).Text
UserForm1.TextBox4 = Sheets(1).Range("D" + Vall3).Text
UserForm1.TextBox5 = Sheets(1).Range("E" + Vall3).Text
UserForm1.TextBox6 = Sheets(1).Range("J" + Vall3).Text
UserForm1.TextBox12 = Sheets(1).Range("K" + Vall3).Text
UserForm1.TextBox7 = Sheets(1).Range("M" + Vall3).Text
UserForm1.TextBox8 = Sheets(1).Range("N" + Vall3).Text
UserForm1.TextBox10 = Sheets(1).Range("O" + Vall3).Text
UserForm1.TextBox11 = Sheets(1).Range("P" + Vall3).Text
UserForm1.Show
End Sub
Related
So I have this code that sets object properties of a class in a for loop, saving each object as an element in an array, BREobjects(). The very next code is below and the first BREobjects(i).BREdays is throwing an
Object variable not set error.
It's a Public array so it shouldn't need to be redim'ed or anything. Anyone know what's happening?
Code that sets the object properties:
'creates a new object for each BRE day/time combination
count = 0
For Each i In BREitems
BREdaysString = Split(Cells(i.Row, "c").value, ", ")
For j = LBound(BREdaysString) To UBound(BREdaysString)
count = count + 1
ReDim Preserve BREobjects(count)
Set BREobjects(count) = New BREpptObjects
BREobjects(count).BREname = Cells(i.Row, "a").value
BREobjects(count).BREcategory = Cells(i.Row, "b").value
BREobjects(count).BREstartTime = Cells(i.Row, "d").value
BREobjects(count).BRElength = Cells(i.Row, "e").value
BREobjects(count).BREtimeRight = Right(Cells(i.Row, "d").value, 2)
BREobjects(count).BREdays = BREdaysString(j)
'Sets the start row number accounting for BREs that start on the half hour
If BREobjects(count).BREtimeRight = 0 Then
BREobjects(count).BREstartRow = (Cells(i.Row, "d").value / 100) + 3
BREobjects(count).BREremainder = 0
ElseIf BREobjects(count).BREtimeRight <> 0 Then
BREobjects(count).BREstartRow = ((Cells(i.Row, "d").value - BREobjects(count).BREtimeRight) / 100) + 3
BREobjects(count).BREremainder = 1
End If
'determines the row the BRE ends in
If BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) = 0 Then
BREobjects(count).BREendRow = BREobjects(count).BREstartRow + BREobjects(count).BRElength - 1
ElseIf BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) > 0 Or BREobjects(count).BREremainder = 1 Then
BREobjects(count).BREendRow = BREobjects(count).BREstartRow + Fix(BREobjects(count).BRElength)
End If
If BREobjects(count).BREremainder = 1 And BREobjects(count).BRElength >= 1 Then
BREobjects(count).BREendRow = BREobjects(count).BREendRow + 1
End If
'sets the end time
If BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) = 0 Then
BREobjects(count).BREendTime = BREobjects(count).BREstartTime + (100 * BREobjects(count).BRElength)
ElseIf BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) > 0 Then
BREtimeRight = Right(BREobjects(count).BRElength, 2)
BREobjects(count).BREendTime = BREobjects(count).BREstartTime + (100 * Fix(BREobjects(count).BRElength)) + (BREtimeRight * 60)
End If
BREobjects(count).BREID = BREobjects(count).BREname & " " & BREobjects(count).BREdays & " " & _
BREobjects(count).BREstartTime & " " & BREobjects(count).BREendTime & " " & BREobjects(count).BRElength
Next j
Erase BREdaysString
Next i
'This loop throws an Object variable or with block variable not set error.
'Thrown on the array in the line BREdays = BREobjects(i).BREdays.
Back:
For i = LBound(BREobjects) To UBound(BREobjects)
Dim BREdays As String
BREdays = BREobjects(i).BREdays
If FiveDay = True And BREdays = "Saturday" Or BREdays = "Sunday" Then
Call DeleteElement(i, BREobjects()) 'Deletes the BREppt Object from the BREobjects array
ReDim Preserve BREobjects(UBound(BREobjects) - 1) 'Shrinks the array by one, removing the last one
GoTo Back 'Restarts the loop because the UBound has changed
End If
Debug.Print BREobjects(i).BREID
Next i
If you were to refactor you code using a collection and move some of the property setting to the class module it could reduce the code to something like this.
Sub ExportToPPTButton_Click()
Dim wb As Workbook, ws As Worksheet, iLastRow As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
iLastRow = ws.Cells(Rows.count, 1).End(xlUp).Row
Dim BREobjects As New Collection
Dim obj As BREpptObjects2, arDays As Variant
Dim i As Long, dow As Variant, sKey As String, s As String
Dim FiveDays As Boolean
' dictionary to count multiple day/time
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
FiveDays = True
For i = 5 To iLastRow
s = ws.Cells(i, "D")
s = Replace(s, " ", "") 'remove spaces
arDays = Split(s, ",")
For Each dow In arDays
s = LCase(Left(dow, 3))
If (FiveDays = True) And (s = "sat" Or s = "sun") Then
' skip weekends
Else
Set obj = New BREpptObjects2
obj.BREDays = dow
obj.initialise ws.Cells(i, 1)
' avoid duplicate day/time
sKey = obj.BREDays & obj.BREstartTime
obj.BREpic = dict(sKey) + 0
dict(sKey) = dict(sKey) + 1
' add to collection
BREobjects.Add obj, obj.BREID
End If
Next
Next
' set total objects in cell
For Each obj In BREobjects
sKey = obj.BREDays & obj.BREstartTime
obj.BREobjInCell = dict(sKey)
Next
MsgBox BREobjects.count & " objects added to collection"
For Each obj In BREobjects
obj.dump ' debug.print objects
Next
End Sub
Note : I used Public here for demo but use Private in your code
' class BREpptObjects2
Public BREname As String, BRElocation As String, BREcategory As String
Public BREstartTime As String, BREendTime As String
Public BRElength As Double
Public BREDays As String, BREID As String, BREStartRow, BREEndRow
Public BREobjInCell As Integer, BREpic As Integer
Sub initialise(rng As Range)
Dim StartHour As Integer, StartMin As Integer
Dim DurHour As Integer, DurMin As Integer
Dim EndHour As Integer, EndMin As Integer
With rng
BREname = .Offset(0, 0).Value ' A
BRElocation = .Offset(0, 1).Value 'B
BREcategory = .Offset(0, 2).Value 'C
BREstartTime = .Offset(0, 4).Value 'E
BRElength = .Offset(0, 5).Value 'F
End With
StartHour = Int(BREstartTime / 100)
StartMin = BREstartTime Mod 100
DurHour = Fix(BRElength)
DurMin = (BRElength - DurHour) * 60
' set end time
EndHour = StartHour + DurHour
EndMin = StartMin + DurMin
If EndMin > 60 Then
EndMin = EndMin - 60
EndHour = EndHour + 1
End If
BREendTime = EndHour * 100 + EndMin
'Sets the start row number accounting for BREs that start on the half hou
BREStartRow = StartHour + 3
BREEndRow = EndHour + 3
BREID = BREname & " " & BREDays & " " & _
BREstartTime & " " & BREendTime & " " & BRElength
End Sub
Sub dump()
Debug.Print "ID [" & BREID & "]"
Debug.Print "StartTime", BREstartTime, "End TIme", BREendTime, "Length", BRElength
Debug.Print "StartRow", BREStartRow, "EndRow", BREEndRow
Debug.Print "pic", BREpic, "objInCell", BREobjInCell
End Sub
this is a continuation of my previous question...
I'm trying to create a user form that will go through a list on a worksheet (TESTER). The form should display the first row of data from the list. User will also be able to select one of two options Active or ITW. Finally, the user is free to add additional comments.
This is where I'm running into trouble, once the user clicks Add, the values from the form should populate the next blank row in a separate sheet (pasteHere). I have no issues with the form displaying the next line of data on the list, but I don't know how to create a loop that will allow me to find the next blank row after clicking the add button. At the moment, I've only initialized j as 1. And every time I click add, it will paste on the first row in the pasteHere worksheet.
Sub addBtn_Click()
Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Dim j As Long
j = 1 'how can I loop this part
Set pasteSheet = Application.Worksheets("pasteHere")
pasteSheet.Cells(j, j) = ric
pasteSheet.Cells(j, j + 2) = name
pasteSheet.Cells(j, j + 4) = valueUSD
pasteSheet.Cells(j + 1, j) = dstr
i = i + 1
j = j + 2
UserForm1_Initialize
End Sub
Would appreciate any help here. Full code below:
Public valueUSD, name, ric, dstr, sitchStr, pStr As String
Public i, lRow As Long
Sub UserForm1_Initialize()
If Worksheets("pasteHere").Range("A1") = "" Then
i = 2
End If
activeCheck.Value = False
itwCheck.Value = False
TextBox2.Value = ""
ric = Worksheets("Tester").Range("H" & i)
name = Worksheets("Tester").Range("B" & i)
valueUSD = Worksheets("Tester").Range("C" & i)
sitchStr = ""
dstr = ""
pStr = ric & " " & name & " " & valueUSD & " "
UserForm1.Label1.Caption = pStr
End Sub
Sub activeCheck_Change()
If activeCheck.Value = True Then
sitchStr = sitchStr + activeCheck.Caption
Else
sitchStr = ""
End If
End Sub
Sub itwCheck_Change()
If activeCheck.Value = False And itwCheck.Value = True Then
sitchStr = sitchStr + itwCheck.Caption
ElseIf activeCheck.Value = True And itwCheck.Value = True Then
MsgBox ("You can only be active OR ITW")
End If
End Sub
Sub TextBox2_Change()
dstr = sitchStr & ", " & TextBox2.Value
End Sub
Sub addBtn_Click()
Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Dim j As Long
j = 1 'how can I loop this part
Set pasteSheet = Application.Worksheets("pasteHere")
pasteSheet.Cells(j, j) = ric
pasteSheet.Cells(j, j + 2) = name
pasteSheet.Cells(j, j + 4) = valueUSD
pasteSheet.Cells(j + 1, j) = dstr
i = i + 1
j = j + 2
UserForm1_Initialize
End Sub
Sub skipBtn_Click()
i = i + 1
UserForm1_Initialize
End Sub
Sub exitBtn_Click()
Unload Me
End Sub
I have create this script in VBA
Sub code_piece_motoculture()
Randomize
caractere = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
lettre_nombre = ""
For i = 1 To 15
nombre_alea = Int(Len(caractere) * Rnd) + 1
lettre_nombre = lettre_nombre & Mid(caractere, nombre_alea, 1)
If i = 5 Then lettre_nombre = lettre_nombre & "-"
If i = 10 Then lettre_nombre = lettre_nombre & "-"
Next
Range("A1") = lettre_nombre
End Sub
And i have this result only in A1
ATBBM-YSHSS-G5ZVH
But i want different result on cells A2->A3->A4->A5 ect
Can you help me ?
Im sure there is cleaner, but this will achieve what you are looking for
Sub code_piece_motoculture()
Randomize
caractere = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
lettre_nombre = ""
For j = 1 To 10 'entrer le nombre de lignes desiree
For i = 1 To 15
nombre_alea = Int(Len(caractere) * Rnd) + 1
lettre_nombre = lettre_nombre & Mid(caractere, nombre_alea, 1)
If i = 5 Then lettre_nombre = lettre_nombre & "-"
If i = 10 Then lettre_nombre = lettre_nombre & "-"
Next
Range("A" & j) = lettre_nombre
lettre_nombre = ""
Next
End Sub
Try this function ...
Public Function GenerateRandomStuff() As String
Dim i As Long, lngNumber As Long, lngBetween As Long
For i = 1 To 15
lngBetween = WorksheetFunction.RandBetween(1, 2)
If lngBetween = 1 Then
lngNumber = WorksheetFunction.RandBetween(48, 57)
Else
lngNumber = WorksheetFunction.RandBetween(65, 90)
End If
GenerateRandomStuff = GenerateRandomStuff & Chr(lngNumber)
If i = 5 Then GenerateRandomStuff = GenerateRandomStuff & "-"
If i = 10 Then GenerateRandomStuff = GenerateRandomStuff & "-"
Next
End Function
... worked nicely for me.
You can add that to a cell and there's no need to extend your macro if you want to add it to more cells, you just copy and paste the formula ...
=GenerateRandomStuff()
... if you want to stop it from refreshing each time, copy and paste special values and you're done.
I have a problem which is the data did not appear in the column. Only the first data. Name data should appear at column B9.
And fyi, name will appear at column A in last data.
The data will come out like this;
Where should I need to fix my error?
And the error I think is at this line -
ws.Cells(totalRows + 1, 1) = txtName.Text
Hope anyone of you can help me.
Thank you in advance.
Private Sub cmdAdd_Click()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Master Data")
Dim Addme As Range, str As String, totalRows As Long
Set Addme = ws.Cells(ws.Rows.Count, 3).End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False
If Me.txtName = "" Or Me.cboAmount = "" Or Me.cboCeti = "" Then
MsgBox "There is insufficient data, Please return and add the needed information"
Exit Sub
End If
totalRows = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
totalRows = Application.WorksheetFunction.Max(totalRows, 3)
ws.Cells(totalRows + 1, 1) = txtName.Text
If cbWhatsapp.Value = True Then
str = "Whatsapp, "
End If
If cbSMS.Value = True Then
str = str & "SMS, "
End If
If cbEmail.Value = True Then
str = str & "Email, "
End If
If cbFacebook.Value = True Then
str = str & "Facebook, "
End If
If cbPhoneCall.Value = True Then
str = str & "Phone Call, "
End If
str = Left(str, Len(str) - 2)
ws.Cells(totalRows + 1, 2) = str
If optYes.Value = True Then
ws.Cells(totalRows + 1, 3) = "Yes"
ElseIf optNo.Value = True Then
ws.Cells(totalRows + 1, 3) = "No"
End If
ws.Cells(totalRows + 1, 4) = cboAmount.Value
ws.Cells(totalRows + 1, 5) = cboCeti.Value
ws.Cells(totalRows + 1, 6) = txtPhone.Text
ws.Cells(totalRows + 1, 7) = txtEmail.Text
ws.Range("B9:H10000").Sort Key1:=Range("F9"), Order1:=xlAscending, Header:=xlGuess
MsgBox "Your data was successfully added"
Sheet1.Select
On Error GoTo 0
Exit Sub
End Sub
I wanted to ask waht am i doing wrong here ?? i want the VLookup to find if the ProjectID is already there , and if it is, I want it to skip the registering step and immediately go to Next Row_T to see the next row of data , whenever i start the error " Application-defined or object-defined error " comes up on the line :
Repetition = Application.WorksheetFunction.VLookup(Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, ProjectID).Value, Worksheets(Issue_SumofSharesWorksheetName).Range("A2:AS"), 1)
i don't know what is wrong , can you please help me ??
For Row_S = 2 To MAX_Row_S
SourceYear = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, SOP).Value
SourceYear = DatePart("yyyy", SourceYear)
SourceCarmaker = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, carmaker).Value
SourceProject = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Project).Value
SourceFamily = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Family).Value
SourceStatus = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Status).Value
SourceShare = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, Share).Value
SourceCst = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, "A").Value
SourcePID = Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, ProjectID).Value
' Take the data from NBG_Data_Region sheet to be Sourceared with each row of the NBG_Data_Source_Region sheet
For Row_T = 2 To MAX_Row_T
If Row_T >= MAX_Row_T Then
Exit For
End If
'NBGMonth = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, SOP).Value
'NBGMonth = DatePart("m", NBGMonth)
NBGYear = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, SOP).Value
NBGYear = DatePart("yyyy", NBGYear)
NBGCarmaker = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, carmaker).Value
NBGProject = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Project).Value
NBGFamily = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Family).Value
NBGStatus = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Status).Value
NBGShare = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Share).Value
NBGCst = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, "A").Value
NBGPID = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, ProjectID).Value
'Get the number of rows in Issue_SumofShares
'SoS = SumofShares
MAX_Row_inSoS = Worksheets(Issue_SumofSharesWorksheetName).UsedRange.RowS.Count
S = MAX_Row_inSoS
Repetition = Application.WorksheetFunction.VLookup(Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, ProjectID).Value, Worksheets(Issue_SumofSharesWorksheetName).Range("A2:AS"), 1)
' StatusBar Show
Application.StatusBar = "VerifySumofShares. Progress: " & Row_S & " of " & MAX_Row_S
'Check if any row with a SOP date in the previous or current years and if it is a D-IN or OPP is found and add it to the IssueSOP_Date sheet
' NAF 20161208
'Test with Source of YEAR and MONTH
' If (NBGMonth = SourceMonth And NBGYear = SourceYear And SourceCarmaker = NBGCarmaker And SourceProject = NBGProject And SourceFamily = NBGFamily And SourceShare + NBGShare <> 1 And NBGCst <> SourceCst) Then
' With Year only
If (NBGYear = SourceYear And SourceCarmaker = NBGCarmaker And SourceProject = NBGProject And SourceFamily = NBGFamily And SourceShare + NBGShare <> 1 And NBGCst <> SourceCst) Then
If IsError(Repetition) = False Then
GoTo Line1
Else: GoTo Line2
End If
Line2:
'Customization of the Issue_SumofShares sheet to show the NBG Data Row , Cst, SOP , Product, Responsible,Family , Carmaker , Share , Status and the GeoRegion of the data which the condition applies to
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "A").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, ProjectID).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "B").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Customer).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "C").Value = GetMonthAndQuarter(Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, SOP).Value)
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "D").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Product).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "E").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Family).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "F").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Project).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "G").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, carmaker).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "H").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Share).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "I").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Responsible).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "K").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, Status).Value
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "L").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, "BO").Value
' Region As String
Region = ""
'Add any other GeoRegion which is also responsible in the recorded data
If Worksheets(NBG_DataWorksheetName).Cells(Row_T, "BC") Then
Region = Region + "#EMEA"
End If
If Worksheets(NBG_DataWorksheetName).Cells(Row_T, "BD") Then
Region = Region + "#AMERICAS"
End If
If Worksheets(NBG_DataWorksheetName).Cells(Row_T, "BE") Then
Region = Region + "#GCSA"
End If
If Worksheets(NBG_DataWorksheetName).Cells(Row_T, "BF") Then
Region = Region + "#JAPAN&KOREA"
End If
Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "J").Value = Region
'Count the number of the cases recorded
Issue_SumofSharesCnt = Issue_SumofSharesCnt + 1
'If there is no items , the Message to show
ElseIf (Worksheets(NBG_SourceRegionDataWorksheetName).Cells(Row_S, SOP).Value = "There are no items to show in this view.") Then
End If
Line1:
Next Row_T
Next Row_S
Repetition = Application.WorksheetFunction.VLookup( _
Worksheets(NBG_RegionaDataWorksheetName).Cells(Row_T, ProjectID).Value, _
Worksheets(Issue_SumofSharesWorksheetName).Range("A2:AS"), 1)
This will throw a run-time error if the value being looked up is not found. Safer to use this approach:
Repetition = Application.VLookup(...)
If Not IsError() Then
'was found
Else
'not found
End If
Omitting the WorksheetFunction means the function will instead return an error value which you can test for. Also, you should always include the last argument Falseto VLookup unless you really want the default behavior.
As a side note, your code will be significantly more readable if you use variables to refer to your sheets instead repeating the full path every time:
Dim wsISOS As Worksheet
Set wsISOS = Worksheets(Issue_SumofSharesWorksheetName)