Creating a list of items from multiple tabs, into a single sheet.

jmk15315

Board Regular
Joined
Nov 7, 2021
Messages
59
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Good morning,
I am currently working on a macro that will compile information from various sheets in a workbook into a single, separate sheet within the same workbook.
The data in the sheets that I want to compile contain information on multiple rows. I want to be able to select the data from all rows that contain a specific value in a certain column.

This is what I thought would work, but it does not. Hoping someone can show me the errors in my code.

Public Sub JIF(InitiationSheet As String, ColumnNumber As Integer)
Dim tmpRow As Integer
Dim tmpLastRow As Integer, tmpLastRow2 As Integer
Dim tmpIntVar As Integer

'FG-0100
ActiveWorkbook.Sheets(InitiationSheet).Unprotect (CAT_PROTECT)

tmpRow = 43

tmpRow = tmpRow + 1

'Insert cost sheet properties
tmpLastRow = ActiveWorkbook.Sheets("Platform").Range("Total_Platform").Row
If tmpLastRow = 4 Then tmpLastRow = 8
ListItems = ActiveWorkbook.Sheets("Platform").Range("A4:A" & tmpLastRow).Value
ListX = ActiveWorkbook.Sheets("Platform").Range("J4:J" & tmpLastRow).Value
ListItems = Application.WorksheetFunction.Transpose(ListItems)
ListX = Application.WorksheetFunction.Transpose(ListX)

Dim Coli As Integer
For tmpIntVar = 1 To UBound(ListItems)
If ListX(1, tmpIntVar) = "FG0100" Then

ActiveSheet.Cells(tmpRow, 1) = ListItems(tmpIntVar)
For Coli = 2 To 11
ActiveSheet.Cells(tmpRow, Coli) = ListX(Coli - 1, tmpIntVar)

Next Coli
tmpRow = tmpRow + 1
End If
Next tmpIntVar

ActiveSheet.Unprotect (CAT_PROTECT)

'FG-0200
tmpRow = tmpRow + 1
ActiveSheet.Cells(tmpRow, ColumnNumber) = "FG-0100"

tmpRow = tmpRow + 1

tmpLastRow = ActiveWorkbook.Sheets("Robot").Range("Total_Robot").Row
ListItems = ActiveWorkbook.Sheets("Robot").Range("a4:a" & tmpLastRow).Value
ListX = ActiveWorkbook.Sheets("Robot").Range("J4:J" & tmpLastRow).Value
ListItems = Application.WorksheetFunction.Transpose(ListItems) ' convert values to a vertical array
ListX = Application.WorksheetFunction.Transpose(ListX)

For tmpIntVar = 1 To UBound(ListItems)
If ListX(1, tmpIntVar) = "FG0200" Then
ActiveSheet.Cells(tmpRow, 1) = ListItems(tmpIntVar)
For Coli = 2 To 11
ActiveSheet.Cells(tmpRow, Coli) = ListX(Coli - 1, tmpIntVar)

Next Coli
tmpRow = tmpRow + 1
End If
Next tmpIntVar

ActiveSheet.Protect (CAT_PROTECT)
VBA Code:
End Sub

Any Thoughts?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,215,105
Messages
6,123,118
Members
449,096
Latest member
provoking

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top