I´ve developed a small macro on Excel using VBA, which compares the information on column C and copies the formating information contained on column F on sheet(3).
The code is working well, however, I´m trying to optimize it. I would like to avoid copying the formating when a given cell already contains the intended formating. Something like:
If Range("C7").Offset(i, 0).***FORMATING*** = Sheets(3).Range("F7").Offset(j, 0).***FORMATING*** Then
Unfortunately, I haven't been able to identify the attribute that defines the formatting of a cell.
Please see below the current code I have:
Sub Contract()
Application.ScreenUpdating = False
Dim i As Integer, j As Integer, Lastrow As Integer, Lastrow2 As Integer
Sheets(1).Activate ' activa a sheet(1)
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
Lastrow2 = Sheets(3).Cells(Rows.Count, "F").End(xlUp).Row
For i = 0 To Lastrow - Range("c7").Row
For j = 0 To Lastrow2 - Range("F7").Row
If Range("C7").Offset(i, 0).Value = Sheets(3).Range("F7").Offset(j, 0).Value Then
Sheets(3).Range("F7").Offset(j, 0).Copy
Range("C7").Offset(i, 0).PasteSpecial Paste:=xlPasteFormats
Exit For
End If
Next j
Next i
End Sub
Thank you for the help.
Related
I'm looking to update a cell on a sheet when it's left empty. If there is data in column B but not in column AA, I need to insert something into column AA.
I have made the following code but have failed to make it update the cell:
Range("B2").Select
Do Until IsEmpty(ActiveCell)
Dim LoopRowNo As Integer
LoopRowNo = ActiveCell.Row
If IsEmpty(Range(Cells(LoopRowNo, 26))) Then Range(Cells(LoopRowNo, 26)).Value = "01/01/1990"
ActiveCell.Offset(1, 0).Select
Loop
Hoping someone can point me in the right direction.
Use Range or Cells, but not both.
Don't Select.
With ActiveSheet
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Dim i As Long
For i = 2 to lastRow
If IsEmpty(.Cells(i, "AA")) And Not IsEmpty(.Cells(i, "B")) Then
.Cells(i, "AA").Value = "01/01/1990"
End If
Next
End With
I have a real hard time putting my logic into excel vba code.
My logic: Comparing cells to cells, if cell A > cell B then continue to loop to the next column. When all the cell from the same column have the same value, then delete the whole column.
Sub deletecol()
Dim LastCol As Range, LastRow As Range, rRange As Range
Dim i As Integer, j As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
With ActiveSheet
For i = 1 To LastRow
For j = 1 To LastCol
If ActiveSheet.Cells(1, 1).Value = ActiveSheet.Cells(i, 1).Value Then
Column(j).EntireColumn.Delete
Else
ActiveSheet.Cells(1,1).Value > ActiveSheet.Cells(i,j).Value Then [this is the part that I'm stuck]
Next j
Next i
End With
End Sub
I believe what you are currently doing is just comparing the cell objects. If you want the values, you must specifically ask for the value.
ActiveSheet.Cells(1,1).Value > ActiveSheet.Cells(i, j).Value
As for using the above as another condition, you might want to look into the Elseif keyword.
Consider the following code
If Range("a2").Value > 0 Then
Range("b2").Value = "Positive"
ElseIf Range("a2").Value < 0 Then
Range("b2").Value = "Negative"
End If
This page does a pretty decent job at explaining conditional controls in VBA
https://www.automateexcel.com/vba/else-if-statement
Working in Excel VBA.
I'm trying to delete a cell, if there is a date in another cell via VBA.
Or another way to put it, I'm trying to delete a cell, if another cell has ANYthing in it. (As it's either a date, or not.)
Here's my code - I just don't know how to recognise any date in the cell.
Sub Upload1ClearADP()
Dim LastRow As Long, x As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
If Cells(x, "G").Value = "Date" Then
Cells(x, "U").ClearContents
End If
Next x
End Sub
You're currently checking for a string Date, not technically an actual date.
Here's your code written to check if it's a date OR is empty:
Sub Upload1ClearADP()
Dim LastRow As Long, x As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
If IsDate(Cells(x, "G").Value) or Cells(x, "G") <> "" Then
Cells(x, "U").ClearContents
End If
Next x
End Sub
Edit: As #Harun24HR points out in the comments, the IsDate() is unnecessary, since you check if the cell is not empty (<> ""). I just wanted to put it there to introduce the IsDate() function.
Edit 2: You can also use SpecialCells() to do the clearing in one line:
Sub Upload1ClearADP()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim dataRng As Range
Set dataRng = Range(Cells(2, "G"), Cells(LastRow, "G"))
' Use 14 because it's 14 columns to the right from
' Column G to U
dataRng.SpecialCells(xlCellTypeConstants).Offset(0, 14).ClearContents
' If you have formulas *and* constants in column G, use:
' Union(dataRng.SpecialCells(xlCellTypeConstants), _
' dataRng.SpecialCells(xlCellTypeFormulas)).Offset(0,14).ClearContents
End Sub
Thanks for taking time to take a look at the problems i am facing..
Been searching and testing for quite a bit but still didnt manage to find out what went wrong.
Right now i have no idea what went wrong.
Below is the current code
this is sheets to be searched
Red area is where the model number is enter, and price is from search results
Sub Search()
Dim LR As Long, i2 As Long
totalsheets = Worksheets.Count
For i = 1 To totalsheets
If Worksheets(i).Name <> "Main" Then
lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To lastrow
If UCase(Worksheets(i).Range("C" & j).Value) Like "*A1-1-35-01*" Then
Worksheets("Main").Activate
Worksheets("Main").Range(k, 4).Value = Worksheets("Main").Range("A", j)
lastrow = Worksheets("Main").Cells(Rows.Count, 1).End(xlUp).Row
End If
Next
End If
Next
End Sub
I have a macro that opens a workbook. I want it to then look into column C and if it finds anything with the text "Draft", delete the entire row. This is my code which does not appear to give me any errors but it does not delete the rows like I want. What am I missing?
enter code here
Dim i As Long
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Archer Search Report")
For i = 2 To FinalRow
If Range("C" & i).Value = "Draft" Then
Rows(i).Delete
End If
Next i
End With
Try this:
Sub DeleteRows()
Dim i As Long, finalRow As Long
finalRow = Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Archer Search Report")
For i = finalRow To 2 Step -1
If Range("C" & i).Value = "Draft" Then
Range("C" & i).EntireRow.Delete
End If
Next i
End With
End Sub
Notes:
It's best to work backwards (Step -1) when deleting otherwise it messes with the row count
I prefer EntireRow.Delete