Subscript out of range within Do-Loop - vba

I have the following partial code and my for loop breaks ONLY on the 35th tab when I try to activate. The code runs correctly for sheets 6-33. I deleted sheet 34 so I'm thinking it might be because it "jumps" to sheet 35. However, when I debug and place the cursor over endTab I see it contains the value 35. The activate for some reason doesn't work only on this sheet and breaks. Any thoughts?
Dim lastRow As Long
Dim startRow As Long
Dim currentRow As Long
Dim endTab As Integer
Sheets(4).activate
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
startRow = 2
Range("A2:AB" & lastRow).Sort key1:=Range("AB2:AB" & lastRow), _
order1:=xlAscending, Header:=xlNo
For i = startRow To lastRow
Sheets(4).activate
endTab = Range("AB" & startRow + i - 2)
Range("A" & startRow + i - 2 & ":" & "AB" & startRow + i - 2).Copy
Worksheets(endTab).activate
Columns("A").Find("", Cells(Rows.Count, "A")).PasteSpecial xlPasteValues
Next

From comments:
Sheet code names are created when the sheet is first created - they do not adjust to match the order of the sheets in the workbook. Your code is addressing "the 35th sheet" (counting your sheet tabs from left to right) which is not the necessarily the sheet with the codename of "Sheet35"

Related

Copy range A:AM in sheet 3 instead of entire row and paste in sheet1 (A1) one below the other

How do I make a change in the code so that it copies only range A:AM in sheet3 till the last row in column D, instead of copying the entire row and paste it in Sheet1 (A1) one below the other?
Option Explicit
Public Sub ABC()
Dim LastRow As Long
LastRow = Sheets(3).Cells(Rows.Count, "d").End(xlUp).Row
Dim iRow As Long
For iRow = 7 To LastRow
If Application.WorksheetFunction.CountA(Sheets(3).Range("J" & iRow & ":AM" & iRow)) <> 0 Then
Sheets(3).Rows(iRow).Copy Destination:=Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next iRow
End Sub
Like this:
Sheets(3).Range("A" & iRow & ":AM" & iRow).Copy
or
Sheets(3).Cells(irow, "A").Resize(1, 39).Copy
or
Sheets(3).Range("A:AM").Rows(iRow).Copy
If your goal is to replace the loop with a entire range copy/paste all at once then:
Create a variable to store the last row index based off column D and then just create your dynamic range to copy accordingly
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("D" & ws.Rows.Count).End(xlUp).Row '<-- Find Last Row
ws.Range("A1:AM" & lr).Copy '<-- Copy
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValues '<-- Paste

How can I copy data from multiple tabs to one tab?

I am trying to copy data from multiple tabs to one single tab. The data need to be filtered first then copied from different tabs to a new tab. Data from different tabs (has random number of lines)should be continuous within the new tab. Due to the size of the data, it is divided into multiple tabs. So merging tabs into one tab first is not an option.
I have below difficulties that need help:
From second tab, I don’t need to copy the header of data. Any command can be added to the code?
Current codes not copying all four tabs, I am not too sure what is the issue
Can my active sheet be a general command instead of specific like ActiveSheet.Range("$A$1:$U$493692")?
See below code
Sub Filter_FSI()
'
' Filter_FSI Macro
'
'
Dim lastRow As String
lastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Train 3-8").Select
ActiveSheet.Range("$A$1:$U$493692").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A1").Select
Sheets("Sheet1").Paste
Sheets("Train 9-14").Select
ActiveSheet.Range("$A$1:$U$539243").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Train 15-25").Select
ActiveSheet.Range("$A$1:$U$528028").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Train 27-41").Select
ActiveSheet.Range("$A$1:$U$298055").AutoFilter Field:=4, Criteria1:="FSI"
ActiveSheet.AutoFilter.Range.Copy
Sheets("Sheet1").Select
Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Copy
Windows("Train Data JULY_Sam Edit.xlsb").Activate
End Sub
So a couple things I noticed with your code - you're declaring lastrow as a string, but that should really be a long since it's representing a number.
Personally, I'm not a fan of autofiltering - and like Peh said above, you want to avoid using Select and Copy/Paste when you can. Try this solution below - it's my personal preference of doing things. We loop through all your worksheets, then loop through every cell in Column D - if it is equal to "FSI", we bring it to Sheet1:
Option Explicit
Sub Filter_FSI()
Dim sht As Worksheet, sht2 As Worksheet
Dim lastrow As Long, i As Long, j As Long, k As Long
Dim myworksheets As Variant
Set sht = ThisWorkbook.Worksheets("Sheet1")
myworksheets = Array("Train 3-8", "Train 9-14", "Train 15-25", "Train 27-41")
'Bring in headers
sht.Range("A1:U1").Value = Worksheets("Train 3-8").Range("A1:U1").Value
k = 2
For i = 0 To UBound(myworksheets)
Set sht2 = Worksheets(myworksheets(i))
lastrow = sht2.Cells(sht2.Rows.Count, 4).End(xlUp).Row
For j = 2 To lastrow
If sht2.Cells(j, 4).Value = "FSI" Then
sht.Range("A" & k & ":U" & k).Value = sht2.Range("A" & j & ":U" & j).Value
k = k + 1
End If
Next j
Next i
End Sub

Apply formula to a range of cells

I have some code which I know works, I am applying a SUMIF formula to a range of cells. It works but it add a load of extra row at the bottom that shouldn't be there. I tried adding in a do until loop but it gets stuck in an infinite loop and crashes.
This is my first lot of code which works but adds the extra row in only on the columns which have been copied over.
Dim z As Workbook 'Budget Workbook
Dim y As Workbook 'Formatted - current workbook
Dim lastRow As Integer
Dim budgLastRow As Integer
Dim rng As Range
Set y = Workbooks("DLT.xlsm")
Set z = Workbooks.Open("C:\Reports\Budget.xlsx")
'Apply function to columns to pull costing data
With y.Worksheets("DLT")
lastRow = Cells(Rows.Count, 5).End(xlUp).Row
For Each rng In .Range("AI22:AI" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!H:H)"
rng.Value = rng.Value
Next rng
For Each rng In .Range("AJ22:AJ" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!I:I)"
rng.Value = rng.Value
Next rng
For Each rng In .Range("AN22:AN" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!E:E)"
rng.Value = rng.Value
Next rng
For Each rng In .Range("AO22:AO" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E" & rng.Row & ",'[Budget.xlsx]DynamicReport'!G:G)"
rng.Value = rng.Value
Next rng
End With
I think the other additional rows have been copied because the budget workbook contains more data then the formatted work book. I have know thought to possibly delete the other unnecessary row which have been copied cross.
So I have added this small piece of code in
With y.Worksheets("Formatted")
lastRow = Cells(Rows.Count, 5).End(xlUp).Row - 1
budgLastRow = Cells(Rows.Count, 35).End(xlUp).Row
Rows("AI" & lastRow & ":AO" & budgLastRow).EntireRow.Delete
End With
I get an application-defined error Object defined error on the line
Rows("AI" & lastRow & ":AO" & budgLastRow).EntireRow.Delete
This is probably not the most efficient way to do this, but its the only way I could think of. I am fairly new to VBA only been coding a couple of months so mostly just try out different ways and see what works. Can anyone help me please.
You didn't properly qualify the ranges for the lastRow variable:
lastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
Note the dots before Cells and Rows.
A couple of additional points:
Always use Long rather than Integer for row variables as there are more rows in a sheet than an Integer can hold.
You don't need to loop to put the same formula in a column of cells.
Dim z As Workbook 'Budget Workbook
Dim y As Workbook 'Formatted - current workbook
Dim lastRow As Long
Dim budgLastRow As Long
Set y = Workbooks("DLT.xlsm")
Set z = Workbooks.Open("C:\Reports\Budget.xlsx")
'Apply function to columns to pull costing data
With y.Worksheets("DLT")
lastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
With .Range("AI22:AJ" & lastRow)
.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E22,'[Budget.xlsx]DynamicReport'!H:H)"
.Value2 = .Value2
End With
With .Range("AN22:AN" & lastRow)
.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E22,'[Budget.xlsx]DynamicReport'!E:E)"
.Value2 = .Value2
End With
With .Range("AO22:AO" & lastRow)
.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$E22,'[Budget.xlsx]DynamicReport'!G:G)"
.Value2 = .Value2
End With
End With

Copy a row from one sheet to a second one if it contains a certain value

I am new to VBA and found what I thought was the answer to my question but is not working. If on my Sheet1 column F contains the value "A - 6:30PM" then I would like the entire row to be copied to a second sheet.
This was the code I was previously using. What is going wrong?
Sub Test()
For Each Cell In Sheets(1).Range("F:F")
If Cell.Value = "A - 6:30PM" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("A").Select
End If
Next
End Sub
Try changing Sheets("A").Select with Sheets(1).Select at the very end of your code.
This is a cleaner way to do it.
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
Dim lRow as Long
'Starting at row 1 loop through each row of the used range.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count
If ws.Range("F" & lRow).Value = "A - 6:30PM" then
Rows(lRow & ":" & lRow).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Rows(lRow).Select
ActiveSheet.Paste
Sheets("A").Select
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
I'm not sure how your paste code knows what row to paste each row to. But if you need to keep track of a row to paste to just add another counter for the second sheet.
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
'Starting at row 1 loop through each row of the used range.
Dim lRow as Long
Dim lTargetRow as Long
lTargetRow = 1
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count
If ws.Range("F" & lRow).Value = "A - 6:30PM" then
Rows(lRow & ":" & lRow).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Rows(lRow).Select
ActiveSheet.Paste
Sheets("A").Select
lTargetRow = lTargetRow + 1
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop

Excel macro advice

I have the following macro running on a workbook to copy data with a specific criteria from "Master" sheet to "Quarantined" sheet;
Dim LR As Long, LR2 As Long
Application.ScreenUpdating = False
With Sheets("Quarantined")
LR2 = .Range("L" & Rows.Count).End(xlUp).Row
If LR2 > 2 Then
.Range("A3:I" & LR2).ClearContents
End If
End With
With Sheets("Master")
LR = .Cells(Rows.Count, 8).End(xlUp).Row
LR2 = Sheets("Quarantined").Range("L" & Rows.Count).End(xlUp).Row
With .Range("L2:L" & LR)
.AutoFilter Field:=1, Criteria1:="QUARANTINED"
.Offset(1).Resize(LR).EntireRow.Copy Sheets("Quarantined").Range("A" & LR2 + 1)
.AutoFilter
End With
End With
Application.ScreenUpdating = True
It works perfectly but if I update the master and run the macro again it pastes it under the original information on the quarantined sheet. How do I get it to overwrite the information that was already there instead of pasting underneath?
Here's hoping
It is pasting under the original info because you are telling it to.
You are clearing your range from .Range("A3:I" & LR2).ClearContents but you are taking the next available row from Col L LR2 = Sheets("Quarantined").Range("L" & Rows.Count).End(xlUp).Row
Either Change your code to this
.Range("A3:L" & LR2).ClearContents
or take the last row based on Col A instead of Col L