insert a value based on certain criteria in attendance sheet - vba

I am putting together a attendance sheet for my workplace. Its going to be partly automated, when a user enters his phone number in the input box his attendance is marked for the day, there is also a input box for the date i.e. just the date not month and year.
Structure of the excel sheet: 2 columns have name and phone number respectively and rest are 1-31 days of the month.
so when a user enter a phone number and date a P (for present) appears under the date column in the same row as the phone number.
Problem : the cell that is being selected by the code is the header which has the dates from 1-31
where am i going wrong?
Please Help.
Thank You
Sub Find_mobilenumber()
Dim FindString As String
Dim FindString1 As String
Dim Rng As Range
FindString = InputBox("Enter Your Mobile Number")
FindString1 = InputBox("Enter todays Date - e.g 21 for 21/03/2015")
If Trim(FindString) <> "" Then
If Trim(FindString1) <> "" Then
With Sheets("Sheet1").Range("D:D") 'searches all of column D
With Sheets("Sheet1").Range("7:7") 'searches all of column 7
Set Rng = .Find(What:=FindString1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True 'value found
If Cell.Value = FindString Goto
MsgBox "Client Checked In"
Else
MsgBox "Client Not Registered" 'value not found
End If
End With
End With
End If
End If
End Sub

Rather than nesting With...End With statements, you can break the search into two easier-to-describe steps: (1) Finding the appropriate row, and (2) Finding the appropriate column. Let's say your design looks like this:
You could adjust your script to populate the "Present" table like so:
Option Explicit
Public Sub Find_mobilenumber()
Dim strMobileNumber As String, strDayOfMonth As String
Dim rngMobileNumbers As Range, rngDaysOfMonth As Range, rng As Range
Dim lngTargetRow As Long, lngTargetCol As Long
Dim wks As Worksheet
'Set references
Set wks = ThisWorkbook.Worksheets("Sheet1")
'Collect mobile number and day of month from user
strMobileNumber = CStr(InputBox("Enter Your Mobile Number"))
strDayOfMonth = CStr(InputBox("Enter todays Date - e.g 21 for 21/03/2015"))
'Stop the script if input is blank
If Trim(strMobileNumber) = "" Or Trim(strDayOfMonth) = "" Then
Call ClientNotRegistered
Exit Sub
End If
'Find the appropriate row by matching mobile number
Set rngMobileNumbers = wks.Range("D:D")
Set rng = rngMobileNumbers.Find(What:=strMobileNumber, LookAt:=xlWhole)
If rng Is Nothing Then
Call ClientNotRegistered
Exit Sub
End If
lngTargetRow = rng.Row
'Find the appropriate column by matching day of month number
Set rngDaysOfMonth = wks.Range("7:7")
Set rng = rngDaysOfMonth.Find(What:=strDayOfMonth, LookAt:=xlWhole)
If rng Is Nothing Then
Call ClientNotRegistered
Exit Sub
End If
lngTargetCol = rng.Column
'Write a "P" in the resulting cell
wks.Cells(lngTargetRow, lngTargetCol) = "P"
MsgBox "Client Checked In"
End Sub
'DRY solution for not found
Public Sub ClientNotRegistered()
MsgBox "Client Not Registered"
End Sub

You start a With block here, but do nothing with it
With Sheets("Sheet1").Range("D:D")
I presume this is where you meant to check the D column for mobile numbers?
How about this revision?
Sub Find_mobilenumber()
Dim FindString As String
Dim FindString1 As String
Dim PhoneRng As Range
Dim Rng As Range
FindString = InputBox("Enter Your Mobile Number")
FindString1 = InputBox("Enter todays Date - e.g 21 for 21/03/2015")
If Trim(FindString) <> "" Then
If Trim(FindString1) <> "" Then
With Sheets("Sheet1").Range("D:D") 'searches for phone no in column D
Set PhoneRng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
With Sheets("Sheet1").Range("7:7") 'searches all of column 7
Set Rng = .Find(What:=FindString1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
On Error GoTo ErrorHandler
Intersect(Rng.EntireColumn, PhoneRng.EntireRow).Value = "P"
MsgBox ("Client Checked In")
End If
End If
Exit Sub
ErrorHandler:
MsgBox ("Client Not Registered")
End Sub

Related

Extend highlight from cell to row

This might be a very dumm question. I would like to point out that I am pretty new to VBA.
By looking in the internet here and there, I managed to create the following code, which I use to highlight all the cells containing a certain date. I would like now to tweak my code and extend the highlighnt to the rows of the cell containing a certain date, so that later I could easily copy and past them into a new tab.
Sub HighlightSpecificValue()
Dim fnd As String, FirstFound As String
Dim FoundDate As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim datetoFind As Date
'Value to be found
fnd = InputBox("Emter the date to be found", "Highlight")
'End Macro if Cancel Button is Clicked or no Text is Entered
If fnd = vbNullString Then Exit Sub
'Convert String value to date format
datetoFind = DateValue(fnd)
Set myRange = Sheets("Tabelle1").Range("E:E")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundDate = myRange.Find(what:=datetoFind, _
after:=LastCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'Test to see if anything was found
If Not FoundDate Is Nothing Then
FirstFound = FoundDate.Address
Else
GoTo NothingFound
End If
Set rng = FoundDate
'Loop until cycled through all unique finds
Do Until FoundDate Is Nothing
'Find next cell with fnd value
Set FoundDate = myRange.FindNext(after:=FoundDate)
'Add found cell to rng range variable
Set rng = Union(rng, FoundDate)
'Test to see if cycled through to first found cell
If FoundDate.Address = FirstFound Then Exit Do
Loop
'Highlight Found cells yellow
rng.Interior.Color = RGB(255, 255, 0)
'Report Out Message
MsgBox rng.Cells.Count & " cell(s) were found containing: " & fnd
Exit Sub
'Error Handler
NothingFound:
MsgBox "No cells containing: " & fnd & " were found in this worksheet"
End Sub
Thanks in advance for your precious help!
Use the EntireRow method of the Range object.
rng.EntireRow.Interior.Color = RGB(255, 255, 0)

Vlookup using the cell address as table_array

I am using vba in excel and I want to do a vlookup from two other excels and store it in the current excel. But I am facing some issue.
Could anyone be kind enough to help me out in this?
I have extracted the cell address for "lookup_value" and "table_array" (for the vlookup) from the two excels respectively by using the user input. And then I am implementing the vlookup and want to paste the result in the current excel(this is the point at which I am facing the issue).
Below is the code:
Public Sub CommandButton4_Click()
Dim Dept_Row As Long
Dim Dept_Clm As Long
Dim myFileName11 As String
Dim E_name1 As String
Dim E_name12 As String
Dim aCell1 As Range
Dim aCell12 As Range
Dim myFileName1 As String
Dim mySheetName1 As String
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Set wkb1 = Workbooks.Open("C:\Users\shashank_khanna\Desktop\extract.csv")
wkb1.Sheets("extract").Activate
Set sht1 = wkb1.Sheets("extract")
E_name1 = InputBox("Enter the matching field name in the Extract.csv :")
If Len(E_name1) > 0 Then
Set aCell1 = sht1.Rows(1).Find(What:=E_name1, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
myFileName1 = wkb1.Name
myFileName11 = myFileName1
mySheetName1 = sht1.Name
Else
MsgBox ("You entered an invalid value")
End If
E_name12 = InputBox("Enter the output field name in the Extract.csv :")
If Len(E_name12) > 0 Then
Set aCell12 = sht1.Rows(1).Find(What:=E_name12, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
MsgBox ("You entered an invalid value")
End If
Dim E_name2 As String
Dim E_name22 As String
Dim aCell2 As Range
Dim aCell22 As Range
Dim myFileName2 As String
Dim mySheetName2 As String
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Set wkb2 = Workbooks.Open("C:\Users\shashank_khanna\Desktop\extract2.csv")
wkb2.Sheets("extract2").Activate
Set sht2 = wkb2.Sheets("extract2")
E_name2 = InputBox("Enter the matching field name in the Extract2.csv :")
If Len(E_name2) > 0 Then
Set aCell2 = sht2.Rows(1).Find(What:=E_name2, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
myFileName2 = wkb2.Name
mySheetName2 = sht2.Name
Else
MsgBox ("You entered an invalid value")
End If
E_name22 = InputBox("Enter the output field name in the Extract2.csv :")
If Len(E_name22) > 0 Then
Set aCell22 = sht2.Rows(1).Find(What:=E_name22, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
MsgBox ("You entered an invalid value")
End If
Dim cellAddress As String
Dim cellAddress1 As String
Dim cellAddress2 As String
Dim Table2 As Worksheet
Dim Table1 As Range
Workbooks("extract.csv").Activate
'Set Table1 = wkb1.Sheets("extract").Columns(aCell1.Column).Select
Set Table1 = Worksheets("extract").Range(aCell1.Address).End(xlDown)
Dim CellString1 As Range
Set CellString1 = Range(aCell2.Address)
Dim CellString2 As Range
Set CellString2 = Range(aCell22.Address)
If (aCell2.Column > aCell22.Column) Then
Workbooks("RunVlookup.xlsm").Activate
Worksheets("Sheet1").Select
For Each cl In Table1
**Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
WorksheetFunction.VLookup("c1",
sht2.Range(Cells(2, aCell22.Column),
Cells(2, aCell2.Column)), 2, False)**
//// I am facing "error 1004 Application defined" on this line.
Next cl
MsgBox "Done"
End If
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Employee Not Present in the table."
End If
End Sub
Thank you.
I have two workbooks:
Extract.csv - Sheet name as 'extract' containing two columns ID and Name.
Extract2.csv - Sheet name as 'extract2' containing two columns "ID" and "Name".
I have another excel RunVlookup.xlsm and I need to do the look up from extract and extract2 workbooks and have the result on Sheet1 of RunVlookup.xlsm.
Could you please help me out on how to achieve this and correct me on the lookup range I am selecting.
aCell22 is the cell with column "ID" in Extract2.csv file.
aCell2 is the cell with column "Name" in Extract2.csv file.
aCell1 is the cell with column 'Name" in Extract.csv file.
WorksheetFunction.VLookup("c1", _
sht2.Range(sht2.Cells(2 aCell22.Column), _
sht2.Cells(2, aCell2.Column)), 2, False)
An unqualified Cells() defaults to the activesheet, so your code fails unless sht2 is active.
Your lookup range is only a single row though, so it's not clear what you intend here.

How to find cell containing string in entire worksheet

I would like to find a cell in a worksheet containing a specific string.
I won't know precisely how many columns or rows there will be in the spreadsheet, hence why I wanted to do it with CurrentRegion.
This is what I was trying:
=FIND("Data String", Range("A1").CurrentRegion)
You should have a look into the Microsoft References: Range.Find Method (Excel).
.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
Example:
Dim rngFound as Range
With Worksheets("MySheetName").Cells
Set rngFound = .Find("MySearchString", LookIn:=xlValues)
If Not rngFound Is Nothing Then
'something is found
else
'nothing found
End If
End With
searches the whole sheet
Try This
FindString = Sheets("Sheet1").Range("D1").Value
---------- This will select the next Cell in range with the inputbox value
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Find Value

VBA, goto cell with a certain value (type: date)

I have code as follow:
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = Range("A1")
If Trim(FindString) <> "" Then
With Sheets("Kalendarz").Range("A5:LY5")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
but it doesn't work with date format, any suggestion?
More details: In A1 cell I will enter a date, In 5. row I have a list of every day in 2016. I want to (after run macro) go to cell with date from cell A1.
Using the Find function to locate a date is notoriously tricky in Excel VBA. The function relies on your search date being formatted in the same way as Excel's default setting. In addition, you need to ensure that the search string is converted to a date within the Find function, using CDate. Ozgrid has a good article on it: http://www.ozgrid.com/VBA/find-dates.htm
I have amended your code below to accommodate those requirements and added an extra With Sheets... statement to ensure the FindString uses the Range from your target sheet.
However, because of the unpredictability of users' adjusting date formats, I prefer a VBA loop, using Value2 which is Excel's numerical representation of the date, so cannot be fiddled with. The Ozgrid article prefers not to use VBA loops when a Find function is so much faster, but I guess it's a matter of personal preference and I feel a bespoke loop is more reliable.
Up to you which one you want to go with.
The Find method:
Sub Find_First()
Dim FindString As String
Dim Rng As Range
With Sheets("Kalendarz")
FindString = .Range("A1")
If Trim(FindString) <> "" Then
With .Range("A5:LY5")
Set Rng = .Find(What:=CDate(FindString), _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End With
End Sub
The VBA loop method:
Sub Find_First_VBA_Loop()
Dim dateVal As Long
Dim cell As Range
With Sheets("Kalendarz")
dateVal = .Range("A1").Value2
For Each cell In .Range("A5:LY5").Cells
If dateVal = cell.Value2 Then
Application.Goto cell, True
Exit For
End If
Next
End With
End Sub

Using VBA to assign a criterion for average.ifs()

I use the following formula in excel
=AVERAGEIFS(B4:B440;A4:A440;"<"&A441;A4:A440;">"&EDATE(A441;-6))
to get the average of a range of values, based on the values in an adjacent column. However I need to apply this formula for more than a thousand dates (column A contains dates). I have a macro, which asks the user to specify sheet name and date (using dialog boxes). So I would like to add some code, that takes the date specified by the user and replaces cell A441 from the above formula with it. Then copy the average, so that I can paste it where desired. Here is what I tried coding so far, with no success:
Sub Find()
Dim FindString As Date
Dim Sumact As Range
Dim Analyst As Double
Dim shname As String
Do Until WorksheetExists(shname)
shname = InputBox("Enter sheet name")
If Not WorksheetExists(shname) Then MsgBox shname & " doesn't exist!", vbExclamation
Loop
Sheets(shname).Select
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets(shname).Range("A:A")
Set Sumact = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Sumact Is Nothing Then
Application.Goto Sumact, True
Else
MsgBox "Nothing found"
End If
End With
End If
Set Analyst = Application.AverageIf(Range(("B:B"), ("A:A")), "<Sumact")
Selection.Copy
End Sub
You do not Set a variable unless you are setting an object like the cell returned by the Range.Find method. Assigning a double to a var should be simply equal (e.g. =).
Sub Make_AVERAGEIFS()
Dim FindString As Date
Dim Sumact As Range
Dim Analyst As Double
Dim shname As String
Dim d As Integer, m As Integer, y As Integer
Do Until WorksheetExists(shname)
shname = InputBox("Enter sheet name")
If Not WorksheetExists(shname) Then MsgBox shname & " doesn't exist!", vbExclamation
Loop
With worksSheets(shname)
.Activate
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With .Range("A:A")
Set Sumact = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Sumact Is Nothing Then
Application.Goto Sumact, True
Else
MsgBox "Nothing found"
End If
End With
End If
If IsDate(Sumact) Then
d = Day(Sumact): m = Month(Sumact): y = Year(Sumact)
Analyst = Application.AverageIfs(.Columns(2), _
.Columns(1), "<" & DateSerial(y, m, d), _
.Columns(1), ">" & DateSerial(y, m - 6, d))
End If
End With
Selection.Copy
End Sub
I suppose that searching for the date in column A is one way to check that the user has input a valid date but there must be other, less complicated methods. The IsDate Function that I have used above is one.