Static date in the last column - vba

I am looking to do an IF THEN statement that will help me put a date into the U Column. However, I am not sure how to go about it.
Sub()
Dim rng1 As Range
Set rng1 = Selection.SpecialCells("U").xlBlanks
If Not rng1 Is Nothing Then rng1.Value = Format(Now(), "mm-dd-yyyy")
End Sub
When I run this code I receive a run-time error '1004'. Can someone help me with this?

First you want to find the range of cells that actually has data, because you don't want to check rows of column U where the entire row itself is empty. So assuming the last possible row of data can be found in column A, you can use this to set the search range.
With Worksheets("Sheet1") 'qualify sheet, change name as needed
Dim lRow as Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Then, you can set the search range to be from Row 1 to lRow, assuming the data is in a contiguous range left-to-right, top-to-bottom starting in A1. (The On Error statements are necessary, since Excel will throw an error if blank cells do not exist in the range).
Dim rngSearch as Range
On Error Resume Next
Set rngSearch = .Range("U1:U" & lRow).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If the range is set then you can enter values into the entire range at once (which you had in your code above).
If Not rngSearch is Nothing Then rngSearch.Value = Format(Now(), "mm-dd-yyyy")
End With

Related

When I use range.offset in VBA, I get error code 1004 application defined object or object defined error due to synatx error

I am trying to use the offset function and cannot figure out the problem with my synatx.
I copied this code from another question about offset on this website.
I want to look for a string in column X (starting at X9 always) and if present, I want to know the value of the cell that is two columns over and in the same row.
I would like to use the offset value in an additional part of the same code, so it needs to be named as a variable, but I decided to see if I could first get VBA to at least read the information I want, hence the message box.
Here is the code:
Private Sub CommandButton3_Click()
Dim LeftStrike As Range
Dim FrameLeftStrike As Range
Dim lastRow As Long
lastRow = Range("X" & Rows.Count).End(xlUp).Row
Set LeftStrike = Range("X9:X" & lastRow)
Set FrameLeftStrike = Range("LeftStrike").Offset(0, 4).Value
For Each FrameLeftStrike In LeftStrike
If InStr(1, LeftStrike.Value, "Foot Strike") > 0 Then
MsgBox FrameLeftStrike
End If
Next FrameLeftStrike
End Sub
The variable "FrameLeftStrike" is the problem.
I receive:
application defined or object defined error.
I tried different iterations.
If I change the line of code to,
Set FrameLeftStrike = Sheet4.Range("LeftStrike").Offset(0, 4).Value
I get the same error.
If I change it to
Set FrameLeftStrike = LeftStrike.Offset(0, 4).Value
I get
run-time error '424' Object required.
I want to use this code in the active sheet only, but the name of the active sheet will change as it will get copied as a template for other projects.
Loop through each cell (my_cell) in Column X (my_range)
Individually check if the cell contains Foot Strike
If so, return the value 2 cells to right in a MsgBox
Sub test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update
Dim my_range As Range, my_cell As Range
Dim lr As Long
lr = ws.Range("X" & ws.Rows.Count).End(xlUp).Row
Set my_range = ws.Range("X9:X" & lr)
For Each my_cell In my_range
If InStr(my_cell, "Foot Strike") Then
MsgBox my_cell.Offset(0, 2)
End If
Next my_cell
End Sub

VBA copy range to another range in next empty cell

Rng1.Copy Destination:=Worksheets("RefindData").Range(Destination)
Where Rng1 is the range of data to be copied and Destination is currently a cell reference (E.g B2)
This code will be called multiple times. How can I alter this so that the destination is the same column (E.g column B) but the row is the next empty cell?
E.g so on the first call, B2 onwards is where the values are copied to, then on the next call the next empty cell after the first call is where the second call should start outputting its values. Then the next empty cell for the start of the third call, and so on.
I can alter the Destination variable to just state column letter if something like this:
Rng1.Copy Destination:=Worksheets("RefindData").Range(Destination & ???)
Is along the right lines?
Sub CopyPasteCells()
Dim Rng1 As Range, Rng2 As Range, ws As Worksheet
Set ws = Worksheets("RefindData")
Set Rng1 = ws.Range("C2:C10") 'Copy range as you like
Set Rng2 = ws.Range("B" & ws.Rows.Count).End(xlUp).Offset(1, 0) 'Paste range starting from B2 and then first empty cell
Rng1.Copy Destination:=Rng2 'Copy/Paste
End Sub
You can also try something like code below.
Assumptions:
Active cell is in the column, where you want to paste the results (you want to paste results in column B -> select cell from B column [for example B2],
The first row is filled with headers, so the results gonna be pasted from second row
Code
Sub CutCopyPaste()
Dim lngCol As Long
Dim rngCopy As Range
Set rngCopy = Range("A1") 'The cell which ic copied
lngCol = Selection.Column 'active column where the results will be pasted
On Error Resume Next
rngCopy.Copy Cells(Cells(1, lngCol).End(xlDown).Row + 1, lngCol)
If Err.Number = 1004 Then
MsgBox "Be sure that active cell is in the column, where the results should be pasted!" & vbNewLine & vbNewLine & "Try again"
Err.Clear
End If
End Sub
You mean like this?
Sub Sample()
Dim rng1 As Range
Dim wsO As Worksheet
Set wsO = Worksheets("RefindData")
Set rng1 = Range("A1:A10")
rng1.Copy Destination:=wsO.Range("B" & _
wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1)
End Sub
Every time you run the macro it will paste in the next available row after the last row.

VBA removing rows from a spreadsheet if cells contain a certain string

I am very new to VBA. I am trying to isolate a particular customers transactions on a spread sheet.
Column "A" contains the Customer payment method (prepaid or various other methods). Column "D" contains the customer we are shipping too, Column "L" contains the customer we are shipping from.
If the cell in column "A" has 'prepaid' I want to search column "D" for the customer name (jaba). I will then delete all rows which do not contain this customer. IF the cell in column "A" is not 'prepaid' I want it to search column "L" for the customer name, and delete all rows which do not contain this string. When I run the code provided below I get an 1004 error on the following script 'If cell3.Find(ContainWord) Is Nothing Then'. Any help would be much appreciated.
Sub DoNotContainClearCells()
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim cell As Range
Dim cell2 As Range
Dim cell3 As Range
Dim ContainWord As String
'What range do you want to search?
Set rng = Range("A:A")
Set rng2 = Range("D:D")
Set rng3 = Range("L:L")
'What phrase do you want to test for?
ContainWord = "jaba"
For Each cell In rng
If cell.Value = "prepaid" Then
'Loop through each cell in range and test cell contents
For Each cell2 In rng2.Cells
If cell2.Find(ContainWord) Is Nothing Then EntireRow.Delete
Next cell2
Else
'Loop through each cell in range and test cell contents
For Each cell3 In rng3.Cells
If cell3.Find(ContainWord) Is Nothing Then EntireRow.Delete
Next cell3
End If
Next
End Sub
Without discussing the logic of your code, which is not part of the question, I can tell you that the
Run-time error '1004': Object required
in this line:
If cell3.Find(ContainWord) Is Nothing Then EntireRow.Delete
is because the EntireRow.Delete is missing a range (see Range.EntireRow Property (Excel))
Solution: Replace these lines:
If cell2.Find(ContainWord) Is Nothing Then EntireRow.Delete
If cell3.Find(ContainWord) Is Nothing Then EntireRow.Delete
with these:
If cell2.Find(ContainWord) Is Nothing Then cell2.EntireRow.Delete
If cell3.Find(ContainWord) Is Nothing Then cell3.EntireRow.Delete
Suggest to always have at the top of the modules\classes\userforms:
Option Explicit
This would have given a Compile error: Variable not defined highlighting the error earlier at compiling time (see Option Explicit Statement)

Code : importing modified cells and adding them in the bottom of the column

Original issue:
I want to import a column in an other sheet and update it by adding the modified cells at the bottom.
I tried the code below but it gives an error in the third line can someone help me?
Fixed by defining lrow
lRow = Worksheets("Analyse de risque").Range("C6").End(xlDown).Row
New issue:
It just adds the same column many times at the bottom, i don't understand why?
Public Sub Refreshing()
Dim aCell As Range
If Worksheets("Analyse").Range("C6:C" & lRow).Cells.Count > 1 Then
For Each aCell In Worksheets("Analyse").Range("C6:C" & lRow).Cells
With aCell
Dim wsI As Worksheet
Dim lRowWsI As Long, lRowWsO As Long
'~~> Find the last row where the data needs to go
lRowWsO = Worksheets("PTR").Range("B" & Worksheets("PTR").Rows.Count).End(xlUp).Row + 1
'~~> Set Input Sheet
Set wsI = Worksheets("Analyse")
With wsI
'~~> Find Last Row to get the range you want to copy
lRowWsI = .Range("C" & .Rows.Count).End(xlUp).Row
'~~> Do the final Copy
.Range("C6:C" & lRowWsI).Copy Destination:=Worksheets("PTR").Range("B" & lRowWsO)
End With
End With
Next
Application.CutCopyMode = False
End If
End Sub
You do not need to loop through the cells in the Analyse sheet. You just need to do the copy and paste one time.
Get rid of:
For Each aCell In Worksheets("Analyse").Range("C6:C" & lRow).Cells
With aCell
and the End With and the Next that match the lines you got rid of.

Copy filtered cells to another sheet

I have four rows of information that I filter. (month, Name, Service, units) I filter the information by name and month. (depending on information needed) I have put together the following to try and grab the top row of filtered data and place it on another sheet.
Sub Mine()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lRow As Long
Set sht1 = ThisWorkbook.Sheets("Export")
Set sht2 = ThisWorkbook.Sheets("DB1")
lRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row + 1
sht1.Range("b" & lRow) = sht2.Range("A2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Month
sht1.Range("a" & lRow) = sht2.Range("E2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Client Name
sht1.Range("c" & lRow) = sht2.Range("C2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Service
sht1.Range("d" & lRow) = sht2.Range("H1" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) 'Units
End Sub
This does not error out, it just doesn't copy anything to the "export" sheet. The only way I can get anything to copy from one sheet to another is to take the specialcells out. As follows...
Sub Mine()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lRow As Long
Set sht1 = ThisWorkbook.Sheets("Export")
Set sht2 = ThisWorkbook.Sheets("DB1")
lRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row + 1
sht1.Range("b" & lRow) = sht2.Range("A2") 'Month
sht1.Range("a" & lRow) = sht2.Range("E2") 'Client Name
sht1.Range("c" & lRow) = sht2.Range("C2") 'Service
sht1.Range("d" & lRow) = sht2.Range("H1") 'Units
End Sub
But as said prior, it only copies the first line, filtered or not. My goal is to obtain the filtered top line of "DB1" and copy it to sequenced cells in "Export". Any assistance would be greatly appreciated.
-JGr3g
Okay, so I don't think your code is doing what you think it is.
Lets take some apart
sht2.Range("A2" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
You're calling sht2.Range() and passing it a string. That string is the concatenation of "A2" and Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible).
What is Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)? Well implicitely Cells is a range representing every cell in the active spreadsheet, ThisWorkbook.ActiveSheet.Cells. Then you're asking for SpecialCells(xlCellTypeLastCell) and taking it's row? What happened to sht1 and sht2? You aren't using them, you're using the active sheet?
So if the last cell of the active sheet is in row 50, you are asking for "A2" & 50 which would get "A250", which would be blank since the last used row is 50...
First things first, I'd recommend you avoid using string concatenation for finding cells. None of this "A" & numericVariable stuff. Use something more direct like Cells(numericVariable, 1). Excessive string manipulation will likely hurt you. The cells property can take a row and a column as parameters.
Is your filered range a table/listobject or just a plain old range with an AutoFilter on it? If it's a listobject, get the listobject, get it's DataBodyRange, use .SpecialCells(xlCellTypeVisible) on that, THEN get the first row of the resulting range.
Similarly if it's an autofiltered range, get the target data range, the entire data range. Once you have that, grab the visible cells, then get the first row.
Edit: Untested example
set targetRow = ws.Range(ws.Cells(2, 1), ws.Cells(lRow, 5)).SpecialCells(xlCellTypeVisible).Row(1)
targetSheet.Range("A2") = targetRow.Cells(1,2)
Okay, so what's this doing? I'm taking a worksheet variable ws and getting a range on it. .Range(ws.Cells(2, 1), ws.Cells(lRow, 5)). That range, is from the second row, first column, aka "A2". It goes to the row number contained in lRow on the 5th column, aka "E" & lRow.
From there it gets only the visible cells .SpecialCells(xlCellTypeVisible) then gets the first row of the first area in the selection .Row(1)
Once we have that first row, we can get different columns from it with either .Cells or .Column.