I am trying to autofill using a macro but it doesnt work... Will only fill H2 and I2 cells, the rest are blank. Whats wrong with my code?
Sub company()
Dim LastRow As Long
With Sheets("Combined")
LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
.Range("H2:H" & LastRow).Value = 0
LastRow = .Cells(Rows.Count, "I").End(xlUp).Row
.Range("I2:I" & LastRow).Value = 1
End With
End Sub
So When i run this macro, the A column will be filled with P's and the C column will be filled with 7's, just as I intended it to.
However I also needed the H and I columns to fill with 0's and 1's respectively.
However on the workbook, each worksheet will have the H and I columns unfilled. Only H2 and I2 will be filled. And in some worksheets the H2 and I2 will be the dates (1/0/1900),(1/1/1900) respectively. In other worksheets H2 and I2 will just have a 0 and 1, respectively.
Why is this happening? And why are some of the incorrect columns dates and others are numbers? How can this be fixed?
Dim i As Long
Dim LastRow As Long
For i = 1 To Worksheets.count
With Sheets(i)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A2:A" & LastRow).Value2 = "P"
LastRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Range("C2:C" & LastRow).Value2 = "7"
LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
.Range("H2:H" & LastRow).Value2 = "0"
LastRow = .Cells(Rows.Count, "I").End(xlUp).Row
.Range("I2:I" & LastRow).Value2 = "1"
End With
Next i
I guess that you have run the code twice and you do not see it changing any more. To see it adding more values every time you run it:
Sub Test()
Dim i As Long
Dim LastRow As Long
For i = 1 To Worksheets.Count
With Sheets(i)
.Columns("A:XFD").NumberFormat = "General"
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A2:A" & LastRow).Value2 = "P"
LastRow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
.Range("C2:C" & LastRow).Value2 = "7"
LastRow = .Cells(Rows.Count, "H").End(xlUp).Row + 1
.Range("H2:H" & LastRow).Value2 = "0"
LastRow = .Cells(Rows.Count, "I").End(xlUp).Row + 1
.Range("I2:I" & LastRow).Value2 = "1"
End With
Next i
End Sub
The problem with (1/0/1900) and (1/1/1900) is that these cells are formatted as date. And 0 is translated to 1/0/1900 and 1 is 1/1/1900. To fix this, in code above the cells are formatted as General with this line:
.Columns("A:XFD").NumberFormat = "General"
Basically, if in Sheet1 the cell in Column I is Not Blank, copy cells A, B, I and L to Sheet 2 on the next available blank row. Loop until end of rows on Sheet1.
I keep getting an error 9 or 450 code at the .Copy line.
I have connected the Module to a button on Sheet2. Could this be the reason?
Or should I use something different from the CopyPaste function?
This is the code I've been trying to get to work.
Option Explicit
Sub copyPositiveNotesData()
Dim erow As Long, lastrow As Long, i As Long
lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Sheet1.Cells(i, "I") <> "" Then
Worksheets("Sheet1").Activate
' *** next line gives Err#450 "Wrong # of arguments or invalid property assignments" ****
Worksheets("Sheet1").Range(Cells(i, "A"), Cells(i, "B"), _
Cells(i, "I"), Cells(i, "L")).Copy
Worksheets("Sheet2").Activate
erow = WorkSheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet2"). _
Range(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"), Cells(i, "D"))
Worksheets("sheet1").Activate
End If
Next i
Application.CutCopyMode = False
End Sub
You need to use Application.Union to merge 4 cells in a row, something like the code below:
Full Modified Code
Option Explicit
Sub copyPositiveNotesData()
Dim erow As Long, lastrow As Long, i As Long
Dim RngCopy As Range
With Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Trim(.Cells(i, "I").Value) <> "" Then
Set RngCopy = Application.Union(.Range("A" & i), .Range("B" & i), .Range("I" & i), .Range("L" & i))
RngCopy.Copy ' copy the Union range
' get next empty row in "Sheet2"
erow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' paste in the next empty row
Worksheets("Sheet2").Range("A" & erow).PasteSpecial xlPasteAll
End If
Next i
End With
Application.CutCopyMode = False
End Sub
You may try this (Not tested)
Option Explicit
Sub copyPositiveNotesData()
Intersect (Sheet1.Range("I2", Sheet1.Cells(.Rows.Count, "I").End(xlUp)).SpeciallCells(xlCellTypeConstants).EntireRow, Sheet1.Range("A:A", "B:B", "I:I", "L:L")).Copy Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0)
End Sub
Looks like the issue is that you are trying to copy multiple cells at once which isn't supported (try doing the same manually within the actual sheet). You need to copy either a single cell or a continuous range. You could either do 4 copy/pastes or could directly set the values in the destination sheet.
Try changing the copy/paste to the following (untested):
Sub copyPositiveNotesData()
Dim erow As Long, lastrow As Long, i As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Sheet1.Cells(i, "I") <> "" Then
With ws2
.Range("A" & i).Value = ws1.Range("A" & i).Value
.Range("B" & i).Value = ws1.Range("B" & i).Value
.Range("I" & i).Value = ws1.Range("I" & i).Value
.Range("L" & i).Value = ws1.Range("L" & i).Value
End With
End If
Next i
End Sub
Sub CHECKas()
Dim lastrow As Long
Dim lastcol As Long
Dim l As Integer
Dim i As Integer
Dim rname As Constants
Set rngTarg = Selection
lastrow = Sheets("report").Range("B" & Rows.Count).End(xlUp).row
lastcol = Sheets("report").Cells(2, Columns.Count).End(xlToLeft).Column
Sheets("FEBBRAIO").Select
ActiveCell.Offset(0, -3).Copy
Sheets("REPORT").Select
Cells(1, lastcol + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
rname = Application.ActiveCell.Value
ActiveCell.Offset(1, 0).Select
For i = 2 To lastrow
ThisWorkbook.Sheets("report").Select
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
Next i
End Sub
I'm new in VBA and I can't understand how to compare a constant value with each cell in a range("g2:g" & lastrow) and ("f2:f" & lastrow). The constant value is an active cell in my case. For example considering this formula: IF(AND($R$1<G2;$R$1>=f2);1;0 where R$1$ is the active cell of the last not empty column in ROW 1. I need to fill the entire column (that is activecell.column) with the output coming out form this formula.
But the I Got mismatch error in:
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
I know from the previous question that this error occurs because I'm trying to comparing a single value against an array of values. How can fix this problem?
You have to use
Range("F" & i)
in your code. Same thing applies to other instances of such code.
I know we can get the last row with data with following code:
LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
But I am having trouble on getting the last Column with data. Here is what i tried bu as you can see from the image it didn't go through
Set ws = ThisWorkbook.ActiveSheet
With ws
Header = 5
LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
LastCol = .Range(5 & .ColumnCount).End(xlLeft).Column
With .Range("A" & Header & LastCol & LastRow)
.Interior.ColorIndex = 16
End With
End With
Can you please let me know hoe I can fix this? thanks
Try this as i've commented:
Lastcol = .Cells(5, Columns.Count).End(xlToLeft).Column
i'm not sure if its xlLeft or xlToLeft. Try it yourself.
Use this to color the entire range:
With .Range(Cells(1,5),Cells(Lastrow,Lastcol)
.Interior.ColorIndex = 16
End With
this colors A5 to your last column and row.