I am writing a macro for Excel VBA to remove old promotions from an excel sheet. The date also has the day of the week before the date. The code below is supposed to remove the day of the week, which because that's when reports come out is always Tue, evaluate if it is before today, then re-add Tue at the beginning. However, instead, it fails to delete Tue from older dates, resulting in older dates saying Tue Tue, then the date. I have tried five different ways of doing this and it has all failed in multiple ways.
For i = 50 To 150
Range("E" & i).Select
Range("E" & i).Replace What:="Tue ", Replacement:=""
If ActiveCell < Date Then
Rows(i).EntireRow.Delete
End If
Range("E" & i).Value = "Tue " & Range("E" & i).Value
Next i
When you delete a row all rows below it get pushed up. You need to either iterate backwards, delete all at once using a unionized range, or just put Range("E" & i).Value = "Tue " & Range("E" & i).Value into an else statement.
To delete the dates you'll want to convert their value to dates as they are currently strings looking like dates.
This one uses a unionized range:
Sub t()
Dim i As Long
Dim delrange As Range
For i = 50 To 150
Range("E" & i).Replace What:="Tue ", Replacement:=""
If CDate(Range("E" & i).Value) < Date Then
If Not delrange Is Nothing Then
Set delrange = Union(delrange, Rows(i).EntireRow)
Else
Set delrange = Rows(i).EntireRow
End If
Else
Range("E" & i).Value = "Tue " & Range("E" & i).Value
End If
Next i
delrange.Delete
End Sub
I also removed your Select and ActiveCell no need for those.
Related
I am still working on streamlining our Attendance worksheet and I decided to add a macro for copying the last three rows and pasting them at the end; the only problem is I need the formula in the first two cells to only change their cell references by 1. The code I have so far is
Sub New_Weekly_Row()
Range("A" & Rows.Count).End(xlUp).Offset(-2).Resize(3).EntireRow.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(3).EntireRow.PasteSpecial
Range("A" & Rows.Count).End(xlUp).Offset(-2).Resize(2, 1).Select
End Sub
I have been trying to see if there is a way to either lock the references (both cells that would be copied would just be something like =U34 and =W34 respectively) to only increasing by one or subtracting two from the cells that are pasted to.
The closest thing I have found so far is
Dim r As Range, b As Integer
Set r = Range("A" & Rows.Count).End(xlUp).Offset(-2)
b = Val(Right(r.Formula, Len(r.Formula) - 3))
b = b - 2
r.Formula = Range("U" & Columns.Count).End(xlUp) + CStr(b)
Range("A" & Rows.Count).End(xlUp).Offset(-1).Select
But that just enters it as plain text.
This worked a few times, but stopped
Sub Update_Reference()
Dim myCell As Range
Range("A" & Rows.Count).End(xlUp).Offset(-2).Resize(2).Select
For Each myCell In Selection
If myCell.HasFormula Then myCell.Formula = Left(myCell.Formula, _
Len(myCell.Formula) - 1) & 4
Next myCell
End Sub
I don't know if this information helps any, but this will be used in conjunction with this
Sub New_Weekly_Row()
Range("A" & Rows.Count).End(xlUp).Offset(-2).Resize(3).EntireRow.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(3).EntireRow.PasteSpecial
Range("U" & Columns.Count).End(xlUp).Offset(1).Resize(1, 2).Merge (Across)
Range("W" & Columns.Count).End(xlUp).Offset(1).Resize(1, 2).Merge (Across)
Range("Y" & Columns.Count).End(xlUp).Offset(1).Resize(1, 2).Merge (Across)
Range("AA" & Columns.Count).End(xlUp).Offset(1).Resize(1, 2).Merge (Across)
Range("U" & Rows.Count).End(xlUp).Resize(1, 8).Copy
Range("U" & Rows.Count).End(xlUp).Resize(1, 8).Offset(1).PasteSpecial
End Sub
My excel file allows the user to upload new reports, each report can contain several invoices (each invoice = 1 row on Excel). If a user imports a new report but it seems to have already been uploaded based on 2 criteria: if the date AND the name appears already in past data, then give the option to replace or keep the old invoices.
Found this code here and adapted it to my sheet:
How to Check for duplicates in 2 columns and copy the entire row into another sheet?
Sub Check()
Dim lw As Long, i As Long
With targetSheet
lw = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lw
If Application.CountIfs(Range("B" & i & ":B" & lw), Range("B" & i).Text, _
Range("E" & i & ":E" & lw), Range("E" & i)) > 1 Then
MsgBox ("A report was made on [DATE] with [NAME]. Do you want to replace the existing report or cancel?")
End If
Next i
End With
End Sub
When I run this, it gives me error: Run-time error '424': Object Required
I also found this site: https://learn.microsoft.com/en-us/office/vba/excel/concepts/cells-and-ranges/prevent-duplicate-entries-in-a-range but not sure how to adapt it ..
Try to do something like this, #Jade:
Public Sub Check()
Dim lw As Long, i As Long
Worksheets("SheetName").Activate
lw = ActiveSheet.Range("A1048576").End(xlUp).Row
For i = 2 To lw
If Application.CountIfs(ActiveSheet.Range("B" & i & ":B" & lw), ActiveSheet.Range("B" & i).Value, ActiveSheet.Range("E" & i & ":E" & lw), ActiveSheet.Range("E" & i).Value) > 1 Then
MsgBox "A report was made on [DATE] with [NAME]. Do you want to replace the existing report or cancel?", vbYesNo, "Title of MSGBOX"
Exit For
End If
Next i
End Sub
Option Explicit
Sub Check()
Dim LastRow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1") '<- Change if needed
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row '<- We assume that all columns have the same number of rows
For i = 2 To LastRow '<- Start loop from second row
'Let as assume that "Date" appears in column B. Check for duplicates
If Application.CountIfs(.Range("B2" & ":B" & LastRow), .Range("B" & i).Value) > 1 Then '<- In order to find the duplicates in whole column avoid using i (used 1 or 2 depended on the row from where the range starts) in the range for search & add "." before range.
'Let as assume that "Name" appears in column E. Check for duplicates
If Application.CountIfs(.Range("E2" & ":E" & LastRow), .Range("E" & i).Value) > 1 Then
MsgBox ("A report was made on [DATE] with [NAME]. Do you want to replace the existing report or cancel?")
End If
End If
Next i
End With
End Sub
Sub Concatenate ()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("K2").Formula = "= TODAY() - I2"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K" & LastRow)
For i = 2 To LastRow
If Range("K" & i).Value < 5 Then Range("J2:J" & i).Value = "Week of" & "" & ("I2:I" & i)
Next i
End Sub
I have a spreadsheet that lists item numbers in Column A, and corresponding dates in column I. Not every item will have a date, so I'm basing the LastRow on Column A to work around the gaps. I want dates in the past to return 0 in column J. I want future dates to return "Week of __" there the __ is the date in column I.
I'm not the most familiar with VBA, and I've run into a bit of a snag. With the above, everything returns "Week of9". I know it's a simple answer, but I have been Googling for an hour. I just need to know the syntax to make the above return the value of "I" at the end of the concatenate as it loops down the rows. If this is a duplicate question, I apologize.
Thanks in advance.
Maybe your condition should be:
If Range("K" & i).Value < 5 Then Range("J" & i).Value = "Week of " & Range("I" & i)
I have an excel VBA macro that transfers some data from one workbook to another. The workbook that the data is sent to is set up with 12 worksheets, each one representing a month. When the user initiates the macro, it determines which sheet to paste the data into from some of the data being transferred. I bring this up because the issue I am having is dependent on the sheet the data will be pasted to. Part of the macro is a do while loop that finds the next available row to paste the data to. This loop only activates on certain sheets. The loop is skipped in other sheets. (For example, the loop will activate if the data will be pasted into the December sheet but not the November sheet or the January Sheet.)
I have stepped through the macro two times. The first time I set the the data to be pasted to the december sheet and the loop worked correctly.
The second time I set the data to be pasted in the January sheet and the loop was skipped over.
With wbOut.Sheets(strSheet)
.Activate
nLastRowOut = .Range("A500").End(xlUp).Row + 1
i = 220
nLastRowOut = i
Do While (i > 41)
str = .Range("A" & i).Value & .Range("B" & i).Value & .Range("C" & i).Value & .Range("D" & i).Value & .Range("E" & i).Value & .Range("F" & i).Value & .Range("G" & i).Value & .Range("H" & i).Value & .Range("I" & i).Value & .Range("J" & i).Value & .Range("K" & i).Value & .Range("L" & i).Value & .Range("M" & i).Value
If Replace(str, 0, "") <> "" Then
nLastRowOut = i + 1
GoTo copySections
End If
i = i - 1
Loop
The next available row should be found and and then used to paste the data.
What is actually happening 75% of the time is that the loop is skipped over and the data is pasted in row 221 instead of the next available row.
The code for the nLastRowOut doesn't look right..
Change this:
nLastRowOut = .Range("A500").End(xlUp).Row + 1
to this:
nLastRowOut = .Range("A" & Rows.Count).End(xlUp).Row + 1
I'm having an issue with trying to expand on the code that I have written. The code I have pasted below is currently working as intended. The issue I have is that I am trying to make the "P2" cell variable. Essentially, I am trying to compare the ("K" & i) cell in the loop to all the dates in the range P2 to AA2 on my sheet. Then if the month and year matches, paste the data in the corresponding column that matched. I have tried replacing the column reference P with another integer, but could not get the nested loop to function correctly. Is there a different way to establish a column as a variable? Thank you for your help.
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
If Month(Range("K" & i)) = Month(Range("P2")) And Year(Range("K" & i)) = Year(Range("P2")) And Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Range("P" & i).PasteSpecial xlPasteValues
End If
Next i
End Sub
Just loop through the columns 16 through 27 inside your existing loop:
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
'loop columns p through aa
For k = 16 to 27
'Instead of Range() we are using Cell() to refer to the column variabl-y... Cells(<rownum>,<columnnum>)
If Month(Range("K" & i)) = Month(Cells(2,k)) And Year(Range("K" & i)) = Year(Cells(2,k)) And Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Cells(i,k).PasteSpecial xlPasteValues
End If
Next k
Next i
End Sub