Been stuck for a while. I hope someone can help me with my current issue, and point me to why I'm having error
Object Required 424 error
Here is the sheet I'm working on, and here is my current code:
note: (me.cmbveh.value is a combo box on my vba form)
Dim v_name As String
Dim add_date As Date
v_name = Me.cmbveh.Value
add_date = Application.WorksheetFunction.VLookup(v_name, Sheets("Vehicle Database").Range("F14:R33"), 13, False)
Application.WorksheetFunction.VLookup(v_name, Sheets("Vehicle Database").Range("F14:R33"), 13, False).Select
ActiveCell.Value = DateSerial(Year(add_date) + 1, Month(add_date), Day(add_date))
The error is pointing in this line of code:
Application.WorksheetFunction.VLookup(v_name, Sheets("Vehicle Database").Range("F14:R33"), 13, False).Select
What I'm trying to do here is, if the value on my combo box has a match on my table, I would like to be able to add 1 year on the "Registration Expiry Date" column.
Any help would be appreciated!
Since you know you are looking to compare your cmbveh Combo-Box value, with the values in Column F, you can use the Application.Match to find the row number that matches the value in the Combo-Box. Afterwards, you can get the row refference (add 13 to it, since your Range starts from row 14 and not row 1), and read the value from Column "R" (where you store your "REGISTRATION EXPIRY DATE").
At last, use the DateAdd function to add 1 year to exisitng date (by choosing "yyyy" as the interval parameter).
Code
Option Explicit
Private Sub CommandButton1_Click()
Dim v_name As String
Dim add_date As Date
Dim MatchRow As Variant
v_name = Me.cmbveh.Value
With Sheets("Vehicle Database")
' first test to see if Match criteria was met (found in Column F)
If Not IsError(Application.Match(v_name, .Range("F14:F33"), 0)) Then
MatchRow = Application.Match(v_name, .Range("F14:F33"), 0) '<-- get row number
.Range("R" & MatchRow + 13).Value = DateAdd("yyyy", 1, .Range("R" & MatchRow + 13).Value)
End If
End With
End Sub
Related
I want to have a pop-up appear when the spreadsheet is opened.
Each tech is required to log their issues in the spreadsheet. When the sheet is opened, I would like it to check for the user's username against the issue list and alert them of any that have exceed their time estimate. If any issue is beyond the estimated time frame, I want the sheet to pop-up a dialog box or windows saying you have Issues A,B,C,, and that those issues need to be closed or extended.
Col A is issue Number.
Col B is the date an issue was started.
Col C is the number of Days expected for issue to be resolved (30, 60, 90, X - using a dropdown menu for these options. X Meaning it is going to be an extended time frame; unknown at entry.)
Col D is the status either Closed or Open also controlled by dropdown.
Col E is the closure date which I'm already handling using a VBA code to auto-populate when closed is chosen from dropdown.
Col F is the name of the tech handling issue.
SS of Spreadsheet
Here is where I am with the code
'DECLARE VARIABLE
Dim x_matrix As Range
Dim x_copyrange, sheet_name, issueString, currentTechName As String
Dim x_step, x_fnl_row As Long
Dim issIDCol, issStatCol, issTechCol, IssLogDateCol As Variant
Dim IssExpClosCol As Variant
'DEFINE VARIABLE
sheet_name = "Log" 'PUT YOUR SHEET NAME
issueString = "Alerts have been found to be late, Please extend or Close"
issIDCol = Columns(1) 'Put Your Report ID Column
currentTechName = Application.UserName 'returns username currently using sheet
issTechCol = Columns(6) 'The Tech name column
issStatCol = Columns(4) ' The Issue Status Column
IssLogDateCol = Columns(2) 'Column where you are logging the date issue reported
IssExpClosCol = Columns(3) '30, 60, 90, X Column
'CREATE MATRIX
x_fnl_row = Worksheets(sheet_name).Cells(Rows.Count, 1).End(xlUp).Row
'Find last row of Log # Col & used to make the loop larger each time an entry is added
Let x_copyrange = "a" & 1 & ":" & "F" & x_fnl_row
'sets a1 to bottom of last entry in F as a range
Set x_matrix = Worksheets(sheet_name).Range(x_copyrange)
'Sets the parameters for X_Matrix as a range on the worksheet
'LOOP TO
x_step = Rows(2) 'Skips the header row at the top of sheet so loop will not loop through row 1
Do While x_step <= x_fnl_row 'Sets the loop to run through the range as long as the final row is farther down then the first row
'This is your Loop
'Make your Conditions Here
'Issue is open and issue date starting is greater than expected closure date.
'Tech Names Match
If x_matrix(x_step, IssExpClosCol) <> "PPSC Closure" Then ' Xmatrix is the whole range (Xstep is the rows of range, tells it what col to search)
If x_matrix(x_step, issTechCol) = currentTechName And _
x_matrix(x_step, issStatCol) = "OPEN" And _
Now() > x_matrix(x_step, IssLogDateCol) + x_matrix(x_step, IssExpClosCol) _
Then
issueString = issueString + x_matrix(x_step, issIDCol) + ", "
End If
End If
x_step = x_step + 1
Loop
MsgBox (issueString)
End Sub
I posted some code below that works based on the how i set up my spreadsheet columns (see attached picture). I think this might be what you are asking for. Take a look see if it will work for you.
Sub standard()
'DECLARE VARIABLE
Dim x_matrix, y_matrix, z_matrix As Range
Dim x_copyrange, y_copyrange, z_copyrange, sheet_name, issueString, currentTechName As String
Dim x_step, y_step, z_step, x_fnl_row, y_fnl_row, z_fnl_row As Integer
Dim issIDCol, issStatCol, issTechCol, IssLogDateCol, IssExpClosCol As Integer
'DEFINE VARIABLE
sheet_name = "Log" 'PUT YOUR SHEET NAME
issueString = "Alerts have been found to be late, Please extend or Close"
issIDCol = 1 'Put Your Report ID Column
currentTechName = Application.UserName 'Sound like you need to add your VBA here to know the tech using the sheet
issTechCol = 6 'The Tech name column
issStatCol = 4 ' The Issue Status Column
IssLogDateCol = 2 'Column where you are logging the date issue reported
IssExpClosCol = 3 '30, 60, 90, X Column
'CREATE MATIX
x_fnl_row = Worksheets(sheet_name).Cells(Rows.Count, issIDCol).End(xlUp).Row
Let x_copyrange = "a" & 1 & ":" & "e" & x_fnl_row
Set x_matrix = Worksheets(sheet_name).Range(x_copyrange)
'LOOP TO
x_step = 2 'I am guessing you have a Header Row so start at 2
Do While x_step <= x_fnl_row
'This is your Loop
'Make your Conditions Here
'Issue is open and issue date starting is greater than expected closure date.
'Tech Names Match
If x_matrix(x_step, IssExpClosCol) <> "X" Then
If x_matrix(x_step, issTechCol) = currentTechName And _
x_matrix(x_step, issStatCol) <> "Closed" And _
Now() > x_matrix(x_step, IssLogDateCol) + x_matrix(x_step, IssExpClosCol) _
Then
issueString = issueString + x_matrix(x_step, issIDCol) + ", "
End If
End If
x_step = x_step + 1
Loop
MsgBox (issueString)
End Sub
I am trying to change excel functions into vba code. the formula below in Col AC, Row 2...
=IF(ROWS($1:1)< MATCH(0.01,H$2:H$10)+1,"",INDEX(X:X,ROWS($1:1)-MATCH(0.01,H$2:H$10)+1))
...scans the first 10 rows of Col H.
This formula looks for the first none-zero value in the rows of Col H. When it finds that row, then the values in col X will be printed out in Col AC so that the row in Col AC matches the row with the first non-zero value in Col H.
I hope that description makes sense. It works perfectly in excel worksheet. Now, i would like to change it into VBA code, here is what I have...
For i = 2 To lengthRows
With Application.WorksheetFunction
Range("AC" & i) = .IF(Rows(1) < .Match(0.01, Range("H2:H10")) + 1, "", .Index(Columns(24), Rows(1) - .Match(0.01, Range("H2:H10")) + 1))
End With
Next i
...Rows(1) is the first row and Columns(24) is Col X.
When I run the code, I am getting a run-time error mismatch '13: Type mismatch.
I am trying to understand how this previous question was answered: Excel VBA: how to solve Index and Match function type mismatch error
Taking the example from the previous answered question. You're pushing the match result into the index formula. If the match result doesn't find a match then it'll return Error 2042, which when pushed into the Index formula gives the mismatch error.
To adapt that solution for your example would be as follows:
Dim rw As Variant
With Application.WorksheetFunction
For i = 2 To lengthRows
rw = .Match(0.01, Range("H2:H10")) 'Is there a reason you're not specifying the third parameter 0 for exact match?
If Not IsError(rw) Then
Range("AC" & i) = .If(Rows(1) < .Match(0.01, Range("H2:H10")) + 1, "", .Index(Columns(24), Rows(1) - .Match(0.01, Range("H2:H10")) + 1))
Else
' Do something else if there was an error
End If
Next i
End With
I think once you want to use VBA, you need to use the VBA added capabilities, and not stick with the formula you constructed in Excel.
Since, you are looking for the first cell in Column H with a none-zero value, you can easily find it using the Application.Match, but you need to set the third parameter of match to -1 (means Greater than, looking for a match for values > 0.01).
So now, we have the row number, if you want to find the value in Column X for this row, you can use Range("AC2").Value = Range("X" & MatchRow + Rng.Item(0).Row).Value
Code
Option Explicit
Sub ConvertFormulaToVBA()
Dim MatchRow As Variant
Dim Rng As Range
Dim lengthRows As Long, i As Long
lengthRows = Cells(Rows.Count, "H").End(xlUp).Row '<-- get last row with data in Column H (in your example it's 10)
Set Rng = Range("H2:H" & lengthRows) ' <-- set the range to H2 until last row in Column H
MatchRow = Application.Match(0.01, Rng, -1) ' <-- setting the third parameter to -1, meaning greater than 0.01
If Not IsError(MatchRow) Then
Range("AC2").Value = Range("X" & MatchRow + Rng.Item(0).Row).Value
Else
' raise a message box if there is no Match
MsgBox "No none-zero value found at Range " & Rng.Address
End If
End Sub
I am working on a spreadsheet one element of which requires a repetitive copy/paste from current column into next column, then copy/paste values back into the first column. The columns in the worksheet contain figures for each working day of the year.
The idea being to keep moving the formula along from yesterday's column into today's column. This is part of a process carried out each morning before starting to input today's data into the worksheet.
Ideally the formula would always be in today's column but the data in yesterday's column should be pasted back in as special values.
I need a macro to streamline the process.
Example:
Copy data range BM53:BM146
Paste into BN53:BN146
Copy data range BM53:BM146
Paste Special Values back into BM53:BM146
Next morning when I run the macro it should then
Copy data range BN53:BN146
Paste into BO53:BO146
Copy data range BN53:BN146
Paste Special Values back into BN53:BN146
And so on each day.
I found the code below through online searches. The code is for rows down the spreadsheet. I tried to rework it for my need which is columns across the spreadsheet but got into a mess.
Code:
Sub AddToNextRow()
Dim Count, LastRow As Integer
LastRow = Cells(35536, 3).End(xlUp).Row
For Count = 3 To 22
ActiveSheet.Cells(LastRow + 1, Count).Formula = ActiveSheet.Cells(LastRow, Count).Formula
ActiveSheet.Cells(LastRow, Count) = ActiveSheet.Cells(LastRow, Count)
Next Count
End Sub
The code you have found is rubbish. I suggest you do not visit the site where you got it again.
"35536" should have been "65536" but only if the code was posted before 2007. Until Excel 2007, the maximum number of rows in a worksheet was 65536. Since then you would be told to write Rows.Count which gives the number of rows per worksheet for the version of Excel being used.
The first task is to find the correct column. You could search from the column for 1-Jan-2015; for a macro that is only run once per day this would be acceptable. However, I have used function DatePart to find an approximate start column and have then searched backwards or forwards for the correct column. This is a bit OTT. I would normally recommend the minimum necessary to achieve the desired effect but I wanted to show you some of the possibilities.
The code you found uses ActiveSheet. This can be appropriate but rarely is. Using ActiveSheet relies on the user have the correct worksheet active when the macro is started. The macro will probably fail to find today’s date in the wrong sheet but it is better if your code explicitly references the correct worksheet.
Row 51 may be the row containing dates today but will it always be the correct row? I have made the row a parameter in a function call for the first block of code. Defining it as a constant is another option:
Const RowDate as Long = 51
I normally find using a constant the best approach for this type of problem. I have a list on constants at the top of my modules for rows, columns and anything else that is currently fixed but might change in the future. Should the value ever change, amending the constant definition is all that is necessary to fully update the macro.
I have set four rows in worksheet “Daily” to list of dates but with different start columns so I could test all the exist points from the function:
TestData
The code below output this to the Immediate Window:
Column in row 51 for today is 63=BK
Column in row 41 for today is 64=BL
Column in row 44 for today is 66=BN
Column in row 47 for today is 60=BH
Option Explicit
Sub TestFindColToday()
Dim ColToday As Long
ColToday = FindColToday("Daily", 51)
Debug.Print "Column in row 51 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 41)
Debug.Print "Column in row 41 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 44)
Debug.Print "Column in row 44 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 47)
Debug.Print "Column in row 47 for today is " & ColToday & "=" & ColNumToCode(ColToday)
End Sub
Function FindColToday(ByVal WshtName As String, RowDate As Long) As Long
Dim ColToday As Long
Dim Today As Date
Today = Date
ColToday = DatePart("y", Today) * 5 / 7
With Worksheets(WshtName)
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' This column is after the column for Today
' Move back until correct column found or does not exist
Do While True
ColToday = ColToday - 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value < Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
Else
' This column is before the column for Today
' Move forward until correct column found or does not exist
Do While True
ColToday = ColToday + 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
End If
End With
End Function
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function
I think what you are doing is copying formats, values and formulae forward one column then overwriting the formulae in the yesterday’s columns with their values. If I am wrong, I believe there is enough information for you to adjust the macro to your exactly requirements. Come back with questions as necessary but the more you can do yourself, the faster you will develop.
Sub CopyYesterdayToTodayAndFixYesterday()
' "Yesterday" is the last working day before today. For Tuesday to
' Friday this will be yesterday. For Monday it will Friday. This will
' not be true if columns are omitted for public holidays.
Const RowDate As Long = 51
Const RowCopyFirst As Long = 53
Const RowCopyLast As Long = 146
Const WshtTgtName As String = "Daily"
Dim ColToday As Long
Dim RngSrc As Range
ColToday = FindColToday("Daily", 51)
With Worksheets(WshtTgtName)
Set RngSrc = .Range(.Cells(RowCopyFirst, ColToday - 1), .Cells(RowCopyLast, ColToday - 1))
Debug.Print RngSrc.Address
' Copy yesterday's formats, values and formulae to today
RngSrc.Copy Destination:=.Cells(RowCopyFirst, ColToday)
' Overwrite yesterday's formulae with value
RngSrc.Value = RngSrc.Value
End With
End Sub
It seems you want to copy your formulas from the last used column into a new column then revert the formulas in the original to their values.
with activesheet.cells(53, columns.count).end(xltoleft).resize(94, 1)
.copy destination:=.offset(0, 1)
.value = .value
end with
You should be able to run that daily to generate new columns of formulas to the right. I'm using a set number of rows but those could be adjusted daily as well if it was known what changed them.
I'm relatively new to VBA and I'm trying to write a macro that will compare two columns of data (first and last names). While traversing the column, any time first name = last name (ie. they're both blank or say UNKNOWN) I want the cell in the 9th column to be cleared and the cell in the 10th column to get the value UNKNOWN.
As of now, the code correctly recognizes any time when the first and last name are identical. My problem is that any time first name is a sub-string of any last name (ie. cell I2=David J2=Jones , I3=Joseph J3=Davidson) David gets compared with Davidson and is subsequently erased.
I've spent a while looking for similar problems and I haven't been able to adapt anything to my problem thus far. Thanks in advance for any help.
Sub compare_cols()
Dim Report As Worksheet
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set Report = Excel.ActiveSheet
lastRow = Report.UsedRange.Rows.count
Application.ScreenUpdating = False
For i = 1 To lastRow ' This will find all identical pairs of cells in I,J (blank, blank) or (unknown, unknown). I stays blank, J gets UNKNOWN
For j = 1 To lastRow ' I think its currently erasing any matches (ex. if someones first name is James, it will get erased if there is a last name jameson)
If InStr(1, Report.Cells(j, 10).Value, Report.Cells(i, 9).Value, vbTextCompare) > 0 Then
Report.Cells(i, 9).Value = ""
Report.Cells(i, 10).Value = "UNKNOWN"
Exit For
Else
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Unlike some other languages, you can compare strings in vba just using the "=" sign and that will find exact matches, which is what it appears you are looking for. Try
if Report.Cells(j, 10) = Report.Cells(i, 9) etc.
I need to hide a range of cells using a macro in excel. C11 contains the column index from where I need to start hiding the columns.
Sub test()
Dim i As Integer
Dim j As Integer
Dim rocket As Range
i = Range("c11").Value
j = 12
rocket = Range(Cells(5, i), Cells(5, j))
Range("Rocket").Select
Selection.EntireColumn.Hidden = True
End Sub
The code is giving some unexpected error and as I am a novice, so have no clue what needs to be done..
Tree steps to make your code working:
1st. Add Set key word in appropriate line which is necessary:
Set rocket = Range(Cells(5, i), Cells(5, j))
2nd. Rocket variable represents range, you will NOT need to call it in this way:
Range("Rocket")....
but
rocket....
3rd. Avoid Select method and Selection object always when possible. Therefore the last two lines replace with this single one (which implements 2nd step, too):
rocket.EntireColumn.Hidden = true
That last answer was awesome! Just for someone else's FYI, here is what worked in Excel 2007. The first line is always 3, but the ending line needed to be a variable. That's where I had the problem. THIS FIXED IT! The last 4 lines before the "End If" do the work. Hope this helps!
Dim RowsToHide As Range
Dim RowHideNum As Integer
' Set Correct Start Dates for Billing in New File
Workbooks("----- Combined_New_Students_Updated.xlsx").Activate
Sheets("2015").Activate
StartDateLine1 = Format(START_DATE_1, "ww") - 1 ' Convert Start Date to Week Number
StartDateLine1 = (StartDateLine1 * 6) - 2 ' Convert Start Date to Line Number
If StartDateLine1 >= "10" Then
Cells(4, "q").Value = ""
Cells(StartDateLine1, "q").Value = STATUS_1
Cells(StartDateLine1, "z").Value = "START DATE " + START_DATE_1
RowHideNum = StartDateLine1 - 2
Set RowsToHide = Range(Cells(3, "a"), Cells(RowHideNum, "ab"))
RowsToHide.Select
RowsToHide.EntireRow.Hidden = True
End If