I have an Excel table that is 6 columns wide (A-F) by 13,000 rows when it opens. I want to write a macro that will begin with cell B1 and check to see if it contains a specified letter (which I will put in another, unused cell). If it does, I want to delete the entire row and move the other rows up. Then the macro should begin again with the B1 and repeat the process. If B1 does not contain the specified letter, I want to successively check C1-F1. If any of them contain the specified letter, I want to delete that row, move the other rows up, and begin again with B1.
If none of the cells B1-F1 contain the specified letter, then I want to leave the row in the table. Then I want to begin testing the next row with B2 (or Bn) I want to continue this process until I have checked Fn in the last row with data, and have either kept or deleted that row.
What I want to be left with is a table containing all the rows from the original set where the specified letter appears in any of the cells in columns 2-6 of the row.
I have been away from Excel macros for twenty years, and so really need some pointers as to how to implement the row deletion, moving up the rows, and hard parts like that.
The fastest way to do this is build up a multiple-area range (that is a read-only operation that won't modify the worksheet) and then delete it in a single operation.
This VBA routine should do it:
Public Sub DeleteRowsHavingCriterion()
Dim J As Integer
Dim nrows As Integer
Dim ws As Worksheet
Dim UsedRange As Range
Dim toDeleteRange As Range
Dim ThisRow As Range
Dim DeleteThisRow As Boolean
Set ws = Application.ActiveWorkbook.Worksheets("WorksheetToProcess")
Set UsedRange = ws.UsedRange
Let nrows = UsedRange.Rows.Count
For J = nrows To 1 Step -1
Set ThisRow = UsedRange.Rows(J).EntireRow
DeleteThisRow = ( _
(ThisRow.Cells(1, 2).Value = "LetterForColumnB") Or _
(ThisRow.Cells(1, 3).Value = "LetterForColumnC") Or _
(ThisRow.Cells(1, 4).Value = "LetterForColumnD") Or _
(ThisRow.Cells(1, 5).Value = "LetterForColumnE") Or _
(ThisRow.Cells(1, 6).Value = "LetterForColumnF") _
)
If (DeleteThisRow) Then
If (toDeleteRange Is Nothing) Then
Set toDeleteRange = ThisRow
Else
Set toDeleteRange = Union(toDeleteRange, ThisRow)
End If
End If
Next J
If (Not (toDeleteRange Is Nothing)) Then
toDeleteRange.Delete (XlDeleteShiftDirection.xlShiftUp)
End If
End Sub
Related
I am trying to find the last row the same way I found the last column:
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
I know this way but it is not as helpful as the prior would be:
u = Sheets("Sheet1").Range("A65536").End(xlUp).Row
I tried:
Sheets("Sheet2").Cells(Sheets("Sheet2",1).Rowa.Count).End(xlToUP).Column
Synopsis: I would like the below way for last row.
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
You should use a with statement to qualify both your Rows and Columns counts. This will prevent any errors while working with older pre 2007 and newer 2007 Excel Workbooks.
Last Column
With Sheets("Sheet2")
.Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Last Row
With Sheets("Sheet2")
.Range("A" & .Rows.Count).End(xlUp).Row
End With
Or
With Sheets("Sheet2")
.Cells(.Rows.Count, 1).End(xlUp).Row
End With
How is this?
dim rownum as integer
dim colnum as integer
dim lstrow as integer
dim lstcol as integer
dim r as range
'finds the last row
lastrow = ActiveSheet.UsedRange.Rows.Count
'finds the last column
lastcol = ActiveSheet.UsedRange.Columns.Count
'sets the range
set r = range(cells(rownum,colnum), cells(lstrow,lstcol))
This function should do the trick if you want to specify a particular sheet. I took the solution from user6432984 and modified it to not throw any errors. I am using Excel 2016 so it may not work for older versions:
Function findLastRow(ByVal inputSheet As Worksheet) As Integer
findLastRow = inputSheet.cellS(inputSheet.Rows.Count, 1).End(xlUp).Row
End Function
This is the code to run if you are already working in the sheet you want to find the last row of:
Dim lastRow as Integer
lastRow = cellS(Rows.Count, 1).End(xlUp).Row
I use this routine to find the count of data rows. There is a minimum of overhead required, but by counting using a decreasing scale, even a very large result requires few iterations. For example, a result of 28,395 would only require 2 + 8 + 3 + 9 + 5, or 27 times through the loop, instead of a time-expensive 28,395 times.
Even were we to multiply that by 10 (283,950), the iteration count is the same 27 times.
Dim lWorksheetRecordCountScaler as Long
Dim lWorksheetRecordCount as Long
Const sDataColumn = "A" '<----Set to column that has data in all rows (Code, ID, etc.)
'Count the data records
lWorksheetRecordCountScaler = 100000 'Begin by counting in 100,000-record bites
lWorksheetRecordCount = lWorksheetRecordCountScaler
While lWorksheetRecordCountScaler >= 1
While Sheets("Sheet2").Range(sDataColumn & lWorksheetRecordCount + 2).Formula > " "
lWorksheetRecordCount = lWorksheetRecordCount + lWorksheetRecordCountScaler
Wend
'To the beginning of the previous bite, count 1/10th of the scale from there
lWorksheetRecordCount = lWorksheetRecordCount - lWorksheetRecordCountScaler
lWorksheetRecordCountScaler = lWorksheetRecordCountScaler / 10
Wend
lWorksheetRecordCount = lWorksheetRecordCount + 1 'Final answer
This gives you the last used row in a specified column.
Optionally you can specify the worksheet, otherwise it will take the active sheet.
Function getLastRow(col As Integer, Optional ws As Worksheet) As Long
If ws Is Nothing Then Set ws = ActiveSheet
If ws.Cells(ws.Rows.Count, col).Value <> "" Then
getLastRow = ws.Cells(ws.Rows.Count, col).Row
Exit Function
End If
getLastRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If shtRowCount = 1 Then
If ws.Cells(1, col) = "" Then
getLastRow = 0
Else
getLastRow = 1
End If
End If
End Function
Sub test()
Dim lgLastRow As Long
lgLastRow = getLastRow(2) 'Column B
End Sub
This is the best way I've seen to find the last cell.
MsgBox ActiveSheet.UsedRage.SpecialCells(xlCellTypeLastCell).Row
One of the disadvantages to using this is that it's not always accurate. If you use it then delete the last few rows and use it again, it does not always update. Saving your workbook before using this seems to force it to update though.
Using the next bit of code after updating the table (or refreshing the query that feeds the table) forces everything to update before finding the last row. But, it's been reported that it makes excel crash. Either way, calling this before trying to find the last row will ensure the table has finished updating first.
Application.CalculateUntilAsyncQueriesDone
Another way to get the last row for any given column, if you don't mind the overhead.
Function GetLastRow(col, row)
' col and row are where we will start.
' We will find the last row for the given column.
Do Until ActiveSheet.Cells(row, col) = ""
row = row + 1
Loop
GetLastRow = row
End Function
Problems with normal methods
Account for Blank Rows / Columns -
If you have blank rows or columns at the beginning of your data then methods like UsedRange.Rows.Count and UsedRange.Columns.Count will skip over these blank rows (although they do account for any blank rows / columns that might break up the data), so if you refer to ThisWorkbook.Sheets(1).UsedRange.Rows.Count you will skip lines in cases where there are blank rows at the top of your sheet, for example on this sheet:
This will skip the top row from the count and return 11:
ThisWorkbook.Sheets(1).UsedRange.Rows.Count
This code will include the blank row and return 12 instead:
ThisWorkbook.Sheets(1).UsedRange.Cells(ThisWorkbook.Sheets(1).UsedRange.Rows.Count, 1).Row
The same issue applies to columns.
Full Sheets -
Identifying the last row or column can be difficult if your sheet is full (this only matters if either your data contains over a million lines or might have values in the final rows or columns of your data). For example, if you use xlEndUp or similar and the cell you're referring to is populated then the code will skip over data, in extreme cases your entire data set can be skipped if for example the data continues from the last row of the sheet (where you start your xlEndUp) solidly up to the first row (in this case the result would be 1).
'This code works, but...
'Will not function as intended if there is data in the cell you start with (Cell A:1048576).
Dim Sht1 as Range: Set Sht1 = ThisWorkbook.Sheets(1)
Sht1.Cells(Sht1.Rows.Count, 1).End(xlUp).Row
Columns with blank rows -
The above code also assumes that your data extends the entire way down column 1, if you have blank entries in column 1 you may lose rows as the code will find the first filled row from the bottom only for column 1.
Unnecessary Looping -
Self explanatory, best to avoid looping where possible as if you're dealing with a lot of data and repeating the looping process often it can slow down your code.
Solution
Note that this is targeted at finding the last "Used" Row or Column on an entire sheet, this doesn't work if you just want the last cell in a specific range.
I've setup some Functions here
Private Function GetLastRow(Sheet As Worksheet)
'Gets last used row # on sheet.
GetLastRow = Sheet.UsedRange.Cells(Sheet.UsedRange.Rows.Count, 1).Row
End Function
Private Function GetLastCol(Sheet As Worksheet)
'Gets last used column # on sheet.
GetLastCol = Sheet.UsedRange.Cells(1, Sheet.UsedRange.Columns.Count).Column
End Function
Examples of calling these Functions:
Sub CallFunctions()
'Define the Target Worksheet we're interested in:
Dim Sht1 As Worksheet: Set Sht1 = ThisWorkbook.Sheets(1)
'Print the last row and column numbers:
Debug.Print "Last Row = "; GetLastRow(Sht1)
Debug.Print "Last Col = "; GetLastCol(Sht1)
End Sub
I preferred search last blank cell:
Il you want last empty cell of column you can do that
Dim sh as Worksheet, r as range
set sh = ActiveWorksheet 'if you want an other it's possible
'find a value
'Columns("A:D") 'to check on multiple columns
Set r = sh.Columns("A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
'no value return first row
If r Is Nothing Then Set r = sh.Cells(1, "A") Else Set r = sh1.Cells(r.Row + 1, "A")
If this is to insert new row, find on multiple columns is a good choice because first column can contains less rows than next columns
I use the following function extensively. As pointed out above, using other methods can sometimes give inaccurate results due to used range updates, gaps in the data, or different columns having different row counts.
Example of use:
lastRow=FindRange("Sheet1","A1:A1000")
would return the last occupied row number of the entire range. You can specify any range you want from single columns to random rows, eg FindRange("Sheet1","A100:A150")
Public Function FindRange(inSheet As String, inRange As String) As Long
Set fr = ThisWorkbook.Sheets(inSheet).Range(inRange).find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not fr Is Nothing Then FindRange = fr.row Else FindRange = 0
End Function
Sheet contains commission data for employees.
Data is dumped out of Accounting system each week.
Need to move a cell value "Totals" down 1 row to align with the relevant data.
Have tried to search for the string "Totals" then cut and paste 1 row lower.
The string is in col-A. The dataset size and content rows is variable each week but the target string is always in col-A and needs to drop down 1 row, probably with an offset (1, 0) style of command?
Dim m As Integer
m = 2
Do Until m = 300 'this is set to cover the expected occurrences
On Error Resume Next
Range(A1, A300).Cells("m", 0).Find(What:="Totals").Offset(1, 0) = "TOTALS"
m = m + 1
On Error GoTo 0
Loop
Getting no error messages but no results either!
Forget the 'Cut & Paste'. Simply insert a new row at the 'Totals' row.
dim m as variant
m = application.match("totals", range("A:A"), 0)
if not iserror(m) then
rows(m).insert
end if
(and YES you should qualify your parent worksheets!)
So this is what I think you are after. Define the range where the "Totals" lie - assuming they are in a Row? See below code.
Sub LoopTotals()
Dim cell As Range
Dim myRange As Range
'set the range
Set myRange = Sheet1.Range("A1:AA1")
'loop through range
For Each cell In myRange
'check if text is "Totals"
If Trim(cell.Text) = "Totals" Then
'set the new "Totals" 1 row lower
cell.Offset(1, 0).Value = "Totals"
'delete the old string value
cell.ClearContents
End If
Next
End Sub
Additionally, if the "Totals" are pulled in differently each time from the accounting software then you can run a search to find the "Totals" and then you can reference that row number for you range.
Really hope you can help because i'm going blind on this issue. My spreadsheet has 20 columns and around 20,000 rows. Many rows are duplicates in all but 1 column and I need to Concatenate all the variables from that 1 column, where the rows match. My data is in order, so all duplicate rows are together and currently i have a macro but have to select a range by hand, which is slow.
My question is, can I run a VBA/formula that will match each duplicate partial row within a whole sheet, then concatenate the unique cell of those rows? please see my simplified example.
This code should do the job; I'm sure this question will be closed for being off-topic (or migrated to Stack Overflow, where it actually belongs):
Sub GatherCountries()
'''Subroutine to loop through rows of column A and concatenate data of column C to column D,
'''when row - 1 == row
'Declare local variable types
Dim worksheetName As String
Dim rowNumber, rowEndNumber As Integer
Dim pasteCell As Range
'Declare local variables
worksheetName = ActiveSheet.Name
rowEndNumber = FindLastRow(worksheetName) 'Function call to function defined below
'Loop through each row, starting at line 2 as header is line 1
For rowNumber = 2 To rowEndNumber
With Worksheets(worksheetName) 'Reduce amount of unnecessary repitition
'Case where cell Ax and Bx equal Ax-1 and Bx-1
If .Cells(rowNumber, 1) = .Cells(rowNumber - 1, 1) And _
.Cells(rowNumber, 2) = .Cells(rowNumber - 1, 2) Then
pasteCell.Value = pasteCell.Value & ", " & .Cells(rowNumber, 3) 'Concatenate country to existing string
'Case where cell Ax and Bx does not equal Ax-1 and Bx-1, loop will always enter this first
Else
Set pasteCell = .Cells(rowNumber, 4) 'Set the cell where concatenation should take place
pasteCell.Value = .Cells(rowNumber, 3) 'Populate concatenation cell with first entry of country
End If
End With
Next rowNumber
End Sub
Function FindLastRow(ByVal SheetName As String) As Long
'''Function to return the last row number of column A
Dim WS As Worksheet
On Error Resume Next
Set WS = ActiveWorkbook.Worksheets(SheetName)
FindLastRow = WS.Cells.Find(What:="*", After:=WS.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
On Error GoTo 0
End Function
With some more code it is possible to look up which columns contain the values to check and the values to concatenate, but given the structure of the example in the question, this will do the job as asked:
Input:
Output, after code has ran:
I am trying to find the last row the same way I found the last column:
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
I know this way but it is not as helpful as the prior would be:
u = Sheets("Sheet1").Range("A65536").End(xlUp).Row
I tried:
Sheets("Sheet2").Cells(Sheets("Sheet2",1).Rowa.Count).End(xlToUP).Column
Synopsis: I would like the below way for last row.
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
You should use a with statement to qualify both your Rows and Columns counts. This will prevent any errors while working with older pre 2007 and newer 2007 Excel Workbooks.
Last Column
With Sheets("Sheet2")
.Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Last Row
With Sheets("Sheet2")
.Range("A" & .Rows.Count).End(xlUp).Row
End With
Or
With Sheets("Sheet2")
.Cells(.Rows.Count, 1).End(xlUp).Row
End With
How is this?
dim rownum as integer
dim colnum as integer
dim lstrow as integer
dim lstcol as integer
dim r as range
'finds the last row
lastrow = ActiveSheet.UsedRange.Rows.Count
'finds the last column
lastcol = ActiveSheet.UsedRange.Columns.Count
'sets the range
set r = range(cells(rownum,colnum), cells(lstrow,lstcol))
This function should do the trick if you want to specify a particular sheet. I took the solution from user6432984 and modified it to not throw any errors. I am using Excel 2016 so it may not work for older versions:
Function findLastRow(ByVal inputSheet As Worksheet) As Integer
findLastRow = inputSheet.cellS(inputSheet.Rows.Count, 1).End(xlUp).Row
End Function
This is the code to run if you are already working in the sheet you want to find the last row of:
Dim lastRow as Integer
lastRow = cellS(Rows.Count, 1).End(xlUp).Row
I use this routine to find the count of data rows. There is a minimum of overhead required, but by counting using a decreasing scale, even a very large result requires few iterations. For example, a result of 28,395 would only require 2 + 8 + 3 + 9 + 5, or 27 times through the loop, instead of a time-expensive 28,395 times.
Even were we to multiply that by 10 (283,950), the iteration count is the same 27 times.
Dim lWorksheetRecordCountScaler as Long
Dim lWorksheetRecordCount as Long
Const sDataColumn = "A" '<----Set to column that has data in all rows (Code, ID, etc.)
'Count the data records
lWorksheetRecordCountScaler = 100000 'Begin by counting in 100,000-record bites
lWorksheetRecordCount = lWorksheetRecordCountScaler
While lWorksheetRecordCountScaler >= 1
While Sheets("Sheet2").Range(sDataColumn & lWorksheetRecordCount + 2).Formula > " "
lWorksheetRecordCount = lWorksheetRecordCount + lWorksheetRecordCountScaler
Wend
'To the beginning of the previous bite, count 1/10th of the scale from there
lWorksheetRecordCount = lWorksheetRecordCount - lWorksheetRecordCountScaler
lWorksheetRecordCountScaler = lWorksheetRecordCountScaler / 10
Wend
lWorksheetRecordCount = lWorksheetRecordCount + 1 'Final answer
This gives you the last used row in a specified column.
Optionally you can specify the worksheet, otherwise it will take the active sheet.
Function getLastRow(col As Integer, Optional ws As Worksheet) As Long
If ws Is Nothing Then Set ws = ActiveSheet
If ws.Cells(ws.Rows.Count, col).Value <> "" Then
getLastRow = ws.Cells(ws.Rows.Count, col).Row
Exit Function
End If
getLastRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If shtRowCount = 1 Then
If ws.Cells(1, col) = "" Then
getLastRow = 0
Else
getLastRow = 1
End If
End If
End Function
Sub test()
Dim lgLastRow As Long
lgLastRow = getLastRow(2) 'Column B
End Sub
This is the best way I've seen to find the last cell.
MsgBox ActiveSheet.UsedRage.SpecialCells(xlCellTypeLastCell).Row
One of the disadvantages to using this is that it's not always accurate. If you use it then delete the last few rows and use it again, it does not always update. Saving your workbook before using this seems to force it to update though.
Using the next bit of code after updating the table (or refreshing the query that feeds the table) forces everything to update before finding the last row. But, it's been reported that it makes excel crash. Either way, calling this before trying to find the last row will ensure the table has finished updating first.
Application.CalculateUntilAsyncQueriesDone
Another way to get the last row for any given column, if you don't mind the overhead.
Function GetLastRow(col, row)
' col and row are where we will start.
' We will find the last row for the given column.
Do Until ActiveSheet.Cells(row, col) = ""
row = row + 1
Loop
GetLastRow = row
End Function
Problems with normal methods
Account for Blank Rows / Columns -
If you have blank rows or columns at the beginning of your data then methods like UsedRange.Rows.Count and UsedRange.Columns.Count will skip over these blank rows (although they do account for any blank rows / columns that might break up the data), so if you refer to ThisWorkbook.Sheets(1).UsedRange.Rows.Count you will skip lines in cases where there are blank rows at the top of your sheet, for example on this sheet:
This will skip the top row from the count and return 11:
ThisWorkbook.Sheets(1).UsedRange.Rows.Count
This code will include the blank row and return 12 instead:
ThisWorkbook.Sheets(1).UsedRange.Cells(ThisWorkbook.Sheets(1).UsedRange.Rows.Count, 1).Row
The same issue applies to columns.
Full Sheets -
Identifying the last row or column can be difficult if your sheet is full (this only matters if either your data contains over a million lines or might have values in the final rows or columns of your data). For example, if you use xlEndUp or similar and the cell you're referring to is populated then the code will skip over data, in extreme cases your entire data set can be skipped if for example the data continues from the last row of the sheet (where you start your xlEndUp) solidly up to the first row (in this case the result would be 1).
'This code works, but...
'Will not function as intended if there is data in the cell you start with (Cell A:1048576).
Dim Sht1 as Range: Set Sht1 = ThisWorkbook.Sheets(1)
Sht1.Cells(Sht1.Rows.Count, 1).End(xlUp).Row
Columns with blank rows -
The above code also assumes that your data extends the entire way down column 1, if you have blank entries in column 1 you may lose rows as the code will find the first filled row from the bottom only for column 1.
Unnecessary Looping -
Self explanatory, best to avoid looping where possible as if you're dealing with a lot of data and repeating the looping process often it can slow down your code.
Solution
Note that this is targeted at finding the last "Used" Row or Column on an entire sheet, this doesn't work if you just want the last cell in a specific range.
I've setup some Functions here
Private Function GetLastRow(Sheet As Worksheet)
'Gets last used row # on sheet.
GetLastRow = Sheet.UsedRange.Cells(Sheet.UsedRange.Rows.Count, 1).Row
End Function
Private Function GetLastCol(Sheet As Worksheet)
'Gets last used column # on sheet.
GetLastCol = Sheet.UsedRange.Cells(1, Sheet.UsedRange.Columns.Count).Column
End Function
Examples of calling these Functions:
Sub CallFunctions()
'Define the Target Worksheet we're interested in:
Dim Sht1 As Worksheet: Set Sht1 = ThisWorkbook.Sheets(1)
'Print the last row and column numbers:
Debug.Print "Last Row = "; GetLastRow(Sht1)
Debug.Print "Last Col = "; GetLastCol(Sht1)
End Sub
I preferred search last blank cell:
Il you want last empty cell of column you can do that
Dim sh as Worksheet, r as range
set sh = ActiveWorksheet 'if you want an other it's possible
'find a value
'Columns("A:D") 'to check on multiple columns
Set r = sh.Columns("A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
'no value return first row
If r Is Nothing Then Set r = sh.Cells(1, "A") Else Set r = sh1.Cells(r.Row + 1, "A")
If this is to insert new row, find on multiple columns is a good choice because first column can contains less rows than next columns
I use the following function extensively. As pointed out above, using other methods can sometimes give inaccurate results due to used range updates, gaps in the data, or different columns having different row counts.
Example of use:
lastRow=FindRange("Sheet1","A1:A1000")
would return the last occupied row number of the entire range. You can specify any range you want from single columns to random rows, eg FindRange("Sheet1","A100:A150")
Public Function FindRange(inSheet As String, inRange As String) As Long
Set fr = ThisWorkbook.Sheets(inSheet).Range(inRange).find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not fr Is Nothing Then FindRange = fr.row Else FindRange = 0
End Function
People take a survey and their responses end up in one row in an Excel spreadsheet. People take multiple surveys, so their responses are spread throughout multiple worksheets. These people have IDs they use before every survey.
I want to loop through rows in each worksheet and copy certain cells from the row with a particular person's survey responses. The assumption is the person pulling responses into one spreadsheet knows the ID.
Sub CreateSPSSFeed()
Dim StudentID As String ' (StudentID is a unique identifier)
Dim Tool As Worksheet ' (this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet ' (this is the sheet I'm pulling data from)
Dim i As Integer ' (loop counter)
Tool = ActiveWorkbook.Sheets("ToolSheet")
Survey1 = ActiveWorkbook.Sheets("Survey1Sheet")
' (This is how the loop knows what to look for)
StudentID = Worksheet("ToolSheet").Range("A2").Value
ActiveWorksheet("Survey1").Select ' (This loop start with the Survey1 sheet)
For i = 1 to Rows.Count ' (Got an overflow error here)
If Cells (i, 1).Value = StudentID Then
'!Unsure what to do here-- need the rest of the row
' with the matching StudentID copied and pasted
' to a specific row in ToolSheet, let's say starting at G7!
End If
Next i
End Sub
I researched here and haven't had a lot of luck combining loops with moving across sheets.
This one's not good, but may get you going:
Sub CreateSPSSFeed()
Dim StudentID As String '(StudentID is a unique identifier)
Dim Tool As Worksheet '(this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet '(this is the sheet I'm pulling data from)
'Dim i As Integer '(loop counter) 'You don't need to define it
Set Tool = ActiveWorkbook.Worksheets("ToolSheet") 'you'll need to use the Set command, don't ask why
Set Survey1 = ActiveWorkbook.Worksheets("Survey1Sheet")
ToolLastRow = Tool.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'so you won't need to loop through a million rows each time
Survey1LastRow = Survey1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Survey1LastColumn = Survey1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For j = 2 To ToolLastRow 'For each student ID from A2 down on toolsheet
StudentID = Tool.Cells(j, 1).Value2 '(This is how the loop knows what to look for) 'why define it if you don't use it
'ActiveWorksheet("Survey1").Select '(This loop start with the Survey1 sheet) 'Activeworksheet -> Activeworkbook but unnecessary,see below
For i = 1 To Survey1LastRow '(Got an overflow error here) 'you won't get an overflow error anymore
If Cells(i, 1).Value2 = StudentID Then
'!Unsure what to do here--need the rest of the row with the matching StudentID copied and pasted to a specific row in ToolSheet, let's say starting at G7!
'let's put the data starting at survey1's B# to the cells starting at tool's G#
For k = 2 To Survey1LastColumn '2 refers to B, note the difference between B=2 and G=7 is 5
Tool.Cells(j, k + 5) = Survey1.Cells(i, k)
Next k
End If
Next i
Next j
End Sub
This will check rows 1:500 (can easily change to entire column or different range) in all sheets in the workbook that starts with 'Survey' and paste to the tool sheet.
Ensure you have enough space between student id's on the toolsheet to paste all possible occurrences.
The FIND method is from here: https://msdn.microsoft.com/en-us/library/office/ff839746.aspx
Sub CreateSPSSFeed()
Dim sStudentID As String
Dim shtTool As Worksheet
Dim rFoundCell As Range
Dim sFirstFound As String
Dim rPlacementCell As Range
Dim lCountInToolSheet As Long
Dim wrkSht As Worksheet
'Set references.
With ActiveWorkbook
Set shtTool = .Worksheets("ToolSheet")
sStudentID = .Worksheets("ToolSheet").Cells(2, 1).Value
End With
'Find where the required student id is in the tool sheet.
With shtTool.Range("A:A")
'Will start looking after second row (as this contains the number you're looking for).
Set rPlacementCell = .Find(sStudentID, After:=.Cells(3), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'If the Student ID doesn't appear in column A it
'will find it in cell A2 which we don't want.
If rPlacementCell.Address = .Cells(2).Address Then
'Find the last row on the sheet containing data -
'two rows below this will be the first occurence of our new Student ID.
lCountInToolSheet = .Find("*", After:=.Cells(1), SearchDirection:=xlPrevious).Row + 2
'An existing instance of the number was found, so count how many times it appears (-1 for the instance in A2)
Else
lCountInToolSheet = WorksheetFunction.CountIf(shtTool.Range("A:A"), sStudentID) - 1
End If
'This is where our data will be placed.
Set rPlacementCell = rPlacementCell.Offset(lCountInToolSheet)
End With
'Look at each sheet in the workbook.
For Each wrkSht In ActiveWorkbook.Worksheets
'Only process if the sheet name starts with 'Survey'
If Left(wrkSht.Name, 6) = "Survey" Then
'Find each occurrence of student ID in the survey sheet and paste to the next available row
'in the Tool sheet.
With wrkSht.Range("A1:A500")
Set rFoundCell = .Find(sStudentID, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFoundCell Is Nothing Then
sFirstFound = rFoundCell.Address
Do
'Copy the whole row - this could be updated to look for the last column containing data.
rFoundCell.EntireRow.Copy Destination:=rPlacementCell
Set rPlacementCell = rPlacementCell.Offset(1)
Set rFoundCell = .FindNext(rFoundCell)
Loop While Not rFoundCell Is Nothing And rFoundCell.Address <> sFirstFound
End If
End With
Set rFoundCell = Nothing
End If
Next wrkSht
End Sub
Edit: I've added more comments and extra code as realised the first section would always find the Student ID that is placed in cell A2.
Try this:
Sub CreateSPSSFeed()
Dim StudentID As String '(StudentID is a unique identifier)
Dim rng as Range
StudentID = Worksheet("ToolSheet").Range("A2").Value 'if you get error try to add Set = StudentID.....
j = 7
for x = 2 to sheets.count
For i = 1 to Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row 'last not empty row
If sheets(x).Cells (i, 1).Value = StudentID Then
sheets(x).range(cells(i, 2),cells(i, 6)).copy _'adapt range to your needs
Destination:=activesheet.Cells(j, 7) 'this is G7
j = j + 1
End If
Next i
next x
End Sub
Run this code only from sheet where you pooling data into "Tool".
Now you have nested loop for rows in loop for sheets.
PS: no need to copy entire row, just range with value, to avoid errors.