currently I have this on Sheet2
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A1001")
Range("A2:A1001").Select
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B1001")
Range("B2:B1001").Select
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C1001")
Range("C2:C1001").Select
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D1001")
Range("D2:D1001").Select
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E1001")
Range("E2:E1001").Select
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G1001")
Range("G2:G1001").Select
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H1001")
Range("H2:H1001").Select
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I1001")
Range("I2:I1001").Select
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J1001")
Range("J2:J1001").Select
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K1001")
Range("K2:K1001").Select
Instead of having the destination range A2 to A1001 I want to have A2 to the same last row as sheet1 e.g if in sheet1 the last row is row 147 I want the code to fill down Selection.AutoFill Destination:=Range("A2:A147")
I do not know how to accomplish this.
Thanks
This should work for you...
Sub LastRowAutofill()
On Error Resume Next
Dim wsSheet1 As Worksheet: Set wsSheet1 = Worksheets("Sheet1")
Dim LastRow As Long
LastRow = wsSheet1.Columns(1).Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row
Dim i As Long
With Worksheets("Sheet2")
For i = 1 To 11
If i <> 6 Then .Cells(2, i).AutoFill Destination:=.Range(.Cells(2, i), .Cells(LastRow, i))
Next i
End With
End Sub
Or you can use the following if you want the last row in the entirety of sheet1:
LastRow = wsSheet1.UsedRange.Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row
Assuming your original data is on Sheet1 and you are copying to Sheet2, here's how you would do it:
Dim intLastrow As Integer
intLastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A2").Select
Selection.AutoFill Destination:=Range(cells(2,"A"),cells(intLastrow, "A"))
Sheets("Sheet2").Range(Cells(2, "A"), Cells(intLastrow, "A")).Select
intLastrow = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("Sheet2").Range("B2").Select
Selection.AutoFill Destination:=Range(cells(2,"B"),cells(intLastrow, "B"))
Sheets("Sheet2").Range(Cells(2, "B"), Cells(intLastrow, "B")).Select
Related
I am very new to macro . Iam using this code for concatenating two column values into one column. This code today failed , for 10 first rows of the sheet , and it worked for the rest of the rows.Why happened like this , i havent changed anything at all !
Thanks.
Sub FixCrossSell()
Dim wb As Workbook
Dim lr As Long
Set wb = ThisWorkbook
wb.Worksheets("CrossSell").Activate
Cells(2, 1).Value = "=B2&E2"
lr = Cells(Rows.Count, 2).End(xlUp).Row
Range("A2").Select
Selection.Copy
Range("A3:A" & lr).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.Calculate
Range("A2:A" & lr).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Try this:
Sub FiXCrossSell()
Dim lr As Long
With Worksheets("CrossSell")
lr = .Cells(Rows.Count, 2).End(xlUp).Row
With .Range("A2:A" & lr)
.FormulaR1C1 = "=rc2&rc5"
.Value = .Value
End With
End With
End Sub
Probably just count the cells in column B, then place the Formula in Column A
Sub Button1_Click()
Dim LstRw As Long, Rng As Range, Sh As Worksheet
Set Sh = Sheets("CrossSell")
With Sh
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
Set Rng = .Range("A2:A" & LstRw)
Rng = "=B2&E2"
End With
End Sub
Ah.. I see someone else answered this while I was thinking about it.
I have Autofill Method Out of Range Class Error from some reason and I can't find why. I have lots of formulas in my code and I use it a lot and it is stops my code every time. this is the relavant part of my sub:
'U means union, M means main
'Advanced filter for visual worksheet
UnionWB.Worksheets("Union").ShowAllData
Dim ULR As Long, ULC As Long, MLR As Long
ULR = Cells(Rows.Count, "A").End(xlUp).Row
ULC = Cells(1, Columns.Count).End(xlToLeft).Column
With MainWB.Worksheets(sheet1)
MLR = .Cells(Rows.Count, "A").End(xlUp).Row
End With
MainWB.Worksheets("aheet2").Columns("A:Z").Clear
UnionWB.Worksheets("Union").Range(Cells(1, 1), Cells(ULR, ULC)).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=MainWB.Worksheets("sheet1").Range("A1", "A" & MLR), Unique:=False
UnionWB.Worksheets("Union").Activate
Range("A1", "Y" & ULR).Select
Selection.Copy
MainWB.Worksheets("sheet2").Activate
Range("A1").PasteSpecial xlPasteValues
Range("AB2").Select
Selection.AutoFill Destination:=Range("AB2", "AB" & MLR)
If MLR > 2 Then
With MainWB.Worksheets("sheet1).Range("N2")
ActiveCell.FormulaR1C1 = _
"=IF(ISNUMBER(SEARCH(""sheet2"",RC[-9])),""yes"",""no"")"
Selection.AutoFill Destination:=Range("N2", "N" & MLR)
End With
End If
Selection.AutoFill Destination:=Range("AB2", "AB" & MLR)
Selection.AutoFill Destination:=Range("N2", "N" & MLR)
Change the 2 lines below:
Range("AB2").Select
Selection.AutoFill Destination:=Range("AB2", "AB" & MLR)
To:
Range("AB2").AutoFill Destination:=Range("AB2:AB" & MLR), Type:=xlFillDefault
I have to apply a formula in column S (=concatenate(p1,q2,r3). This formula has to copy down until column end.
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
Range("S1").Select
Selection.copy
Range("S:S").Select
ActiveSheet.Paste
Application.CutCopyMode = False
You do not want the formula all the way to the bottom of column S; you only need it to the last used cell in columns P, Q and R.
dim lr as long
with worksheets("sheet1")
lr = application.max(.cells(.rows.count, "P").end(xlup).row, _
.cells(.rows.count, "Q").end(xlup).row, _
.cells(.rows.count, "R").end(xlup).row)
.range(.cells(1, "S"), .cells(lr, "S")).FormulaR1C1 = "=CONCATENATE(RC[-3], RC[-2], RC[-1])"
end with
I have a column of IDs in an Excel worksheet called Sheet1. I have data that corresponds to the IDs in columns to the right of Column A. The amount of cells in a row varies. For example:
A, B, C, D, E, F, ...
John, 5, 10, 15, 20
Jacob, 2, 3
Jingleheimmer, 5, 10, 11
I'm trying to copy that data into a new worksheet, Sheet5, in the following format:
A, B, C, D, E, F, ...
John, 5
John, 10
John, 15
John, 20
Jacob, 2
Jacob, 3
Jingleheimmer, 5
Jingleheimmer, 10
Jingleheimmer, 11
I wrote the following code that copies over the first two IDs. I could continue to copy paste the second half of the code and just change the cells, however, I have 100s of IDs. This would take too long. I think whenever a process is repeated I should be using a loop. Can you help me turn this repetitive code into a loop?
Sub Macro5()
Dim LastRowA As Integer
Dim LastRowB As Integer
''' Process of copying over first ID '''
'grab all data cells in B2 to the right
With Sheets("Sheet1").Select
Range("B2", Range("B2").End(xlToRight)).Select
Selection.Copy
End With
'paste that data into the first empty cell of Column B in Sheet5
With Sheets("Sheet5").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
'grab the corresponding ID in cell A2
With Sheets("Sheet1").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
End With
'paste the corresponding ID into the first empty cell of Column A in Sheet5
With Sheets("Sheet5").Select
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A1:A" & LastRowB)
End With
''' Repeat that process for each row in Sheet1 '''
'grab all data cells in B3 to the right
With Sheets("Sheet1").Select
Range("B3", Range("B3").End(xlToRight)).Select
Selection.Copy
End With
'paste that data into the first empty cell of Column B in Sheet5
With Sheets("Sheet5").Select
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & LastRowB + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
'grab the corresponding ID in cell A3
With Sheets("Sheet1").Select
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
End With
'paste the corresponding ID into the first empty cell of column A in Sheet5
'and autofill down to the last populated cell in column B
With Sheets("Sheet5").Select
LastRowA = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRowB + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Selection.AutoFill Destination:=Range("A" & LastRowA & ":A" & LastRowB)
End With
End Sub
Try this:
Sub test()
Dim i As Integer
Dim j As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nRow As Integer
Dim lRow As Integer
Dim lCol As Integer
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet5")
nRow = 1
With ws1
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lRow
lCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
For j = 2 To lCol
ws2.Cells(nRow, 1).Value = .Cells(i, 1).Value
ws2.Cells(nRow, 2).Value = .Cells(i, j).Value
nRow = nRow + 1
Next j
Next i
End With
End Sub
It runs through each row in the sheet one at a time, copying over the names and associated numbers up through the last column with values in that row. Should work very quickly and doesn't require constant copy & pasting.
This should do what you're looking for.
Sub test()
Dim lastrow As Long, lastcol As Long
Dim i As Integer, j as Integer, x as Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet5")
lastrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
x = 1
With ws1
For i = 1 To lastrow
lastcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
For j = 2 To lastcol
ws2.Cells(x, 1).Value = .Cells(i, 1).Value
ws2.Cells(x, 2).Value = .Cells(i, j).Value
x = x + 1
Next j
Next i
End With
End Sub
I am using the following if code to filter col A and col B by the value in F1
Once sorted I copy the the filtered values in col A and paste them under the range value.
Then I move on to the next range and repeat the filter using a different range value (in this case cell G1).
I need to repeat this from cell F1 through to cell AH1.
Can I use a loop to do this?
If Range("F1").Value <> "" Then
Selection.AutoFilter
ActiveSheet.Range("$A$2:$B" & LastRow).AutoFilter Field:=2, Criteria1:=Range("F1").Value
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
End If
If Range("G1").Value <> "" Then
Selection.AutoFilter
ActiveSheet.Range("$A$2:$B" & LastRow).AutoFilter Field:=2, Criteria1:=Range("G1").Value
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
End If
Try the loop below. I have refactored your code to not use ActiveSheet and Select statements. Instead I qualify all objects and methods to their parent object and work directly with the object. It will avoid many pitfalls and errors in expected versus actual results of the code.
Dim LastRow As Long
'assume LastRow already set
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'change as needed
With ws
Dim cel As Range
For Each cel In .Range("F1:AH1")
If Len(cel) > 0 Then
ws.UsedRange.AutoFilter
.Range("A2:B" & LastRow).AutoFilter Field:=2, Criteria1:=cel.Value
.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=cel.Offset(1)
End If
Next
End With
See How to Avoid Select