This question already has answers here:
Find last used cell in Excel VBA
(14 answers)
Closed 6 years ago.
Hi I found this code on StackOverflow and I was wondering how I could modify it (see below code snipping...)
Sub TestMacro()
Dim dblRow As Double, dtDate As Date, strProject As String
Dim strFalut As String, strProb As String, strSol As String
dblRow = InputBox("Input on What Row?")
dtDate = InputBox("Date", , Date)
strProject = InputBox("Project #")
strFalut = InputBox("Fault")
strProb = InputBox("Problem")
strSol = InputBox("Solution")
Range("A" & dblRow).Value = dtDate
Range("B" & dblRow).Value = strProject
Range("C" & dblRow).Value = strFalut
Range("D" & dblRow).Value = strProb
Range("E" & dblRow).Value = strSol
End Sub
Its a good start to perform the function that I want it to perform...But I was wondering how I could modify it with a vLookUp to search the for the next empty row and begin entering the data there instead of having to manually define a row, which may lead to operator error as these rows become more populated...
You can get the first blank row like this:
Range("A" & Range("A" & Rows.count).end(xlup).row + 1).value = dtDate
Obviously change both instances of A for the column you are updating.
Alternatively update dblRow = InputBox("Input on What Row?") to this dblRow = range("A" & rows.count).end(xlup).row and leave the rest of the code as is.
Related
I'm writing a macro to concatenate a few columns into another column for a sheet that will eventually have thousands of rows. For the sake of testing I'm using four rows of data. My issue is that the Cells(i,25).Value is not populating when I run the following code. The code isn't breaking and I'm not getting any error messages. I tried assigning a 2 to column 26 using Cells(i,26) and that wasn't working either.
Sub concat()
Dim i As Long
Dim add As String
i = 1
Do Until IsEmpty(Cells(i, 1))
add = Cells(i, 14).Value
Cells(i, 25).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & Left(add, 3)
i = i + 1
Loop
End Sub
Any help or recommendations would be greatly appreciated!
I recommend you change the code a little. I have used the IsEmpty command before and it's not the most suitable one for this.
Sub concat()
Dim i As Long
Dim add As String
Dim last_1 As Long
Dim last_2 As Long
Dim last_14 As Long
Dim lastCell As Long
last_1 = Sheets("test3").Cells(Rows.Count, 1).End(xlUp).Row
last_2 = Sheets("test3").Cells(Rows.Count, 2).End(xlUp).Row
last_14 = Sheets("test3").Cells(Rows.Count, 14).End(xlUp).Row
lastCell = WorksheetFunction.Max(last_1 , last_2, last_14)
For i = 1 To lastCell
add = Sheets("test3").Cells(i, 14).Value
Sheets("test3").Cells(i, 25).Value = Sheets("test3").Cells(i, 1).Value & " " & Sheets("test3").Cells(i, 2).Value & " " & Left(add, 3)
Next i
End Sub
so i have Sheet1 that is use to contain the list of my inventory data. what i want to do is in another sheet(Sheet2). i can search my Sheet1 data and display the data there ( for example when i type cheetos, only the cheetos item got display ). Help me guys, using VBA is okay or other method is also fine.
If your results don't have to be on a different sheet, you could just convert your data to a Table. Select Cells A1:D8 and click on Insert -> Table. Make sure "My table has headers" is clicked and voila!
Once formatted as a table, you can filter Product ID however you need.
If you do need to show these results in another sheet, VBA would be my go-to solution. Maybe something like this:
Public Sub FilterResults()
Dim findText As String
Dim lastRow As Long
Dim foundRow As Long
Dim i As Long
'If there's nothing to search for, then just stop the sub
findText = LCase(Worksheets("Sheet2").Range("D4"))
If findText = "" Then Exit Sub
'Clear any old search results
lastRow = Worksheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Row
If lastRow > 5 Then
For i = 6 To lastRow
Worksheets("Sheet2").Range("C" & i).ClearContents
Worksheets("Sheet2").Range("D" & i).ClearContents
Worksheets("Sheet2").Range("E" & i).ClearContents
Worksheets("Sheet2").Range("F" & i).ClearContents
Next i
End If
'Start looking for new results
lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
foundRow = 6
For i = 2 To lastRow
If InStr(1, LCase(Worksheets("Sheet1").Range("B" & i)), findText) <> 0 Then
Worksheets("Sheet2").Range("C" & foundRow) = Worksheets("Sheet1").Range("A" & i)
Worksheets("Sheet2").Range("D" & foundRow) = Worksheets("Sheet1").Range("B" & i)
Worksheets("Sheet2").Range("E" & foundRow) = Worksheets("Sheet1").Range("C" & i)
Worksheets("Sheet2").Range("F" & foundRow) = Worksheets("Sheet1").Range("D" & i)
foundRow = foundRow + 1
End If
Next i
'If no results were found, then open a pop-up that notifies the user
If foundRow = 6 Then MsgBox "No Results Found", vbCritical + vbOKOnly
End Sub
I would recommend avoiding VBA for this process as it can be done easily with excel's functions. If you would like to do it via VBA one could just loop through the list of products and find a key word, adding it to an array if the "Cheetos" is contained in the specific cell value using a wildcard like so:
This could be modified to run upon the change of the D4 cell if needed, and of course some modifications could be done to ensure that formatting etc can be done to your liking.
Sub test()
Dim wb As Workbook
Dim rng As Range, cell As Range
Dim s_key As String, s_find() As String
Dim i As Long
Set wb = Application.ThisWorkbook
Set rng = wb.Sheets("Sheet1").Range("B2:B8")
s_key = wb.Sheets("Sheet2").Range("D4").Value
wb.sheets("Sheet2").Range("C6:F9999").clearcontents
i = 0
For Each cell In rng
If cell.Value Like "*" & s_key & "*" Then
ReDim Preserve s_find(3, i)
s_find(0, i) = cell.Offset(0, -1).Value
s_find(1, i) = cell.Value
s_find(2, i) = cell.Offset(0, 1).Value
s_find(3, i) = cell.Offset(0, 2).Value
i = i + 1
End If
Next cell
wb.Sheets("Sheet2").Range("C6:F" & 5 + i).Value = Application.WorksheetFunction.Transpose(s_find)
End Sub
I'm new to VBA so sorry if this seems to be a simple question.
I'm trying to create a macro which will formate and include a couple of formulas in a sheet but when I try to include the formula until the last row I get a error "Run Time Error 1004 - Application-Defined or Object Defined Error" at the following code:
ActiveSheet.Range("U2:U" & LastRow).Formula = "=L2/86400"
If I change the "Last Row" for a number the Macro works normally. Below is the whole code.
Sheets("DLASpotPlacement").Select
Dim LastRow As Double
LastRow = Sheets("DLASpotPlacement").Cells(Rows.Count, 1).Rows
Range("A1").Select
ActiveSheet.Range("U:U, V:V, W:W").NumberFormat = "[h]:mm:ss;#"
ActiveSheet.Range("U2:U" & LastRow).Formula = "=L2/86400"
ActiveSheet.Range("V2:V" & LastRow).Formula = "=VALUE(H2)"
ActiveSheet.Range("W2:W" & LastRow).FormulaLocal = "=IF(AND(H2>0,0416666666666667;H2<=0,249988425925926);""01 - 06"";IF(AND(H2>=0,25;H2<0,4166551);""06 - 10"";IF(AND(H2>=0,4166667;H2<0,4999884);""10 - 12"";IF(AND(H2>=0,5;H2<0,7499884);""12 - 18"";""18 - 01""))))"
Thanks for all the help
Copy Excel Formulas
The error occurs because of two reasons:
You forgot End(xlUp) in the LastRow Calculation, e.g.:
LastRow = Sheets("DLASpotPlacement").Cells(Rows.Count, 1).End(xlUp).Row
and it has to be declared as a whole number e.g.:
Dim LastRow as Long
The Code
Option Explicit
Sub CopyFormulas()
Const cCol As Variant = "A" ' Last Row Column Letter/Number
Const cFirstR As Long = 2 ' First Row Number
Dim LastRow As Long ' Last Row Number
With ThisWorkbook.Worksheets("DLASpotPlacement")
LastRow = .Cells(.Rows.Count, cCol).End(xlUp).Row
'.Cells(1, cCol).Select ' uncomment if necessary
' You don't need to format the entire columns.
.Range("U" & cFirstR & ":W" & LastRow).NumberFormat = "[h]:mm:ss;#"
.Range("U" & cFirstR & ":U" & LastRow).Formula = "=L2/86400"
.Range("V" & cFirstR & ":V" & LastRow).Formula = "=VALUE(H2)"
.Range("W" & cFirstR & ":W" & LastRow).FormulaLocal = _
"=IF(AND(H2>0,0416666666666667;H2<=0,249988425925926);""" _
& "01 - 06"";IF(AND(H2>=0,25;H2<0,4166551);""06 - 10"";IF(" _
& "AND(H2>=0,4166667;H2<0,4999884);""10 - 12"";IF(AND(H2>=0" _
& ",5;H2<0,7499884);""12 - 18"";""18 - 01""))))"
End With
End Sub
Remarks
Using FormulaLocal is a nice 'trick' to remember.
#Mike; Your problem is in this line:
LastRow = Sheets("DLASpotPlacement").Cells(Rows.Count, 1).Rows
You made the LastRow an array, not a number. Also, is not a Double but an Iteger (mathematically). However, the Integer datatype is too small and you will get an "Overflow" error if you declare it "As Integer". Here are the two changes you need to make it all work:
Dim LastRow As Long
LastRow = Sheets("DLASpotPlacement").Rows.Count
...
For LastRow, use the Worksheet.UsedRange property.
You could also use the Range.Resize property to select the range, and replace the "Select" with "With".
Dim LastRow As Double
With Sheets("DLASpotPlacement")
LastRow = .UsedRange.Rows.count
.Range("U:W").NumberFormat = "[h]:mm:ss;#"
.Range("U1").Resize(LastRow - 1).Formula = "=L2/86400"
.Range("V1").Resize(LastRow - 1).Formula = "=VALUE(H2)"
.Range("W1").Resize(LastRow - 1).FormulaLocal = "..."
End With
So I have two forms in Sheet EmployeeForm (EmployeeForm1 & EmployeeForm2) and an Excel Table TableEmployee in Sheet EmployeeData that looks like this:
The data in the table comes from the submission from these two forms, but so far I've only succeeded in inputting the first half of the table.
The data in Employee Form 2 is submitted only and only after the Employee Form 1 is submitted (can be days, even weeks later).
Now what I want to achieve is to have a working VBA code that can match the Employee ID in cell D13 with Employee ID in column H correctly, and record the data in D14:D17 to its proper place.
So in this example above, since the Employee ID is 145, once I click the submit button in Form 2, the data in D14:D17 should be stored in L7:O7.
This is my code so far:
Sub Submit_Form1()
Dim LastRow As Long, ws As Worksheet
Set ws = Worksheets("EmployeeData")
LastRow = ws.Range("H" & Rows.Count).End(xlUp).Row + 1
ws.Range("H" & LastRow).Value = Worksheets("EmployeeForm").Range("D5").Value 'Employee ID
ws.Range("I" & LastRow).Value = Worksheets("EmployeeForm").Range("D6").Value 'Employee Name
ws.Range("J" & LastRow).Value = Worksheets("EmployeeForm").Range("D7").Value 'Place of Birth
ws.Range("K" & LastRow).Value = Worksheets("EmployeeForm").Range("D8").Value 'Working Experience
End Sub
And for Form 2
Sub Submit_Form2()
Dim LastRow As Long, ws As Worksheet
Dim H As String
Set ws = Worksheets("EmployeeData")
employeeid = Sheets("EmployeeForm").Range("D13").Value
If Cells(H) = employeeid Then
ws.Range("L" & LastRow).Value = Worksheets("EmployeeForm").Range("D14").Value 'Education
ws.Range("M" & LastRow).Value = Worksheets("EmployeeForm").Range("D15").Value 'Last Company
ws.Range("N" & LastRow).Value = Worksheets("EmployeeForm").Range("D16").Value 'Join Date
ws.Range("O" & LastRow).Value = Worksheets("EmployeeForm").Range("D17").Value 'Position
End Sub
Of course, the second macro doesnt work, but can anybody please enlighten me as how to do this the right way? Thanks a lot!
Can you try this?
Sub Submit_Form2()
Dim ws As Worksheet, v As Variant
Set ws = Worksheets("EmployeeData")
employeeid = Sheets("EmployeeForm").Range("D13").Value
v = Application.Match(employeeid, ws.Range("H:H"), 0)
If IsNumeric(v) Then
ws.Range("L" & v).Value = Worksheets("EmployeeForm").Range("D14").Value 'Education
ws.Range("M" & v).Value = Worksheets("EmployeeForm").Range("D15").Value 'Last Company
ws.Range("N" & v).Value = Worksheets("EmployeeForm").Range("D16").Value 'Join Date
ws.Range("O" & v).Value = Worksheets("EmployeeForm").Range("D17").Value 'Position
End If
End Sub
The problem with your code was
If Cells(H) = employeeid Then
which is not valid syntax. Cells needs a row and column reference such cells(1,1) or cells (1,"A"). Not to mention that H wasn't defined.
I'm creating a Macro to do almost exactly what is outlined here:
Excel/Categorization Macro(formula) based on string of text containing keywords
My question is that in the code from the example above Like "" is used to check to see if the Description matches a keyword and if it does then it pulls the corresponding category name. In my case, I don't currently have keywords for every possible category (but will eventually have them as I collect more transaction data), meaning some of the cells in my keyword column are blank and the way the above code is written it considers patternfound = true when it encounters an empty cell. How do I alter the If statement with "Like" or something similar so that it skips over a cell if it's completely blank and only provides a match when there are some characters (that match) in the cell?
I've found a work around by putting "N/A" in the empty cells but I'd rather not do that. Here is my code:
Sub Categorize()
Dim lastrow As Long, lastrow2 As Long
Dim i As Integer, j As Integer
Dim PatternFound As Boolean
Call speedup
lastrow = Sheets("Categorization").Range("B" & Rows.Count).End(xlUp).Row
lastrow2 = Sheets("Cleaned Spend Data").Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow2
PatternFound = False
j = 1
Do While PatternFound = False And j < lastrow
j = j + 1
If UCase(Sheets("Cleaned Spend Data").Range("B" & i).Value) Like "*" & UCase(Sheets("Categorization").Range("B" & j).Value) & "*" Then
Sheets("Cleaned Spend Data").Range("D" & i).Value = Sheets("Categorization").Range("A" & j).Value
PatternFound = True
End If
Loop
Next i
Call normal
End Sub
Thanks!
You can test for an empty cell...
Also - your code could be cleaner using a couple of variables for your worksheets.
Sub Categorize()
Dim lastrow As Long, lastrow2 As Long
Dim i As Integer, j As Integer
Dim PatternFound As Boolean, shtCat As Worksheet, shtCleaned As Worksheet
Dim v, t
Set shtCat = Sheets("Categorization")
Set shtCleaned = Sheets("Cleaned Spend Data")
Call speedup
lastrow = shtCat.Range("B" & Rows.Count).End(xlUp).Row
lastrow2 = shtCleaned.Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow2
v = UCase(UCase(shtCleaned.Range("B" & i).Value))
For j = 1 To lastrow
t = UCase(Sheets("Categorization").Range("B" & j).Value)
If Len(t) > 0 And v Like "*" & t & "*" Then
shtCleaned.Range("D" & i).Value = shtCat.Range("A" & j).Value
Exit For
End If
Next j
Next i
Call normal
End Sub