How to define a range inside the loop using find in VBA

Question

I'm new with VBA and need some help with my code.

I hope you can understand what I want to do and where I'm stuck.

I have a situation that I'm having an excel file where is listed some product information. There is a separate section for each data set(Product) which starts and ends always with same expression. In the example those are "ID" and "TOTAL".

I would like to transform the data to a template so that each data set would have its own sheet.

Begin of data set is in same format for each set (Yellow colored area) but "Product Data" (Filled with light blue) varies depending how many rows there is for each data set.

The code works fine to get the data from the first rows but I have troubles to define the "Product data" part. I guess it has something to do with the Find command that I'm using to define the end point of the data set.

Defining the Product data set goes well with the first round but the loop stops right after that because it doesn't find the starting cell of the next data set. Instead it picks the last cell of the first data set. In minimum I would like to select the "Product data" part, copy it and paste to the template sheet.

Picture of example data set:

Picture of Template sheet

And to code I'm using.

Sub Create_sheets_from_list()

   'Check if there are some old sheets done. To delete the old ones I have a working macro.
   If Sheets(Sheets.Count).Name <> "Template" Then
   MsgBox "Please delete old calculation sheets"

   Else

    With ThisWorkbook

  On Error GoTo 0

   'variable ProductData to find start point of each product in imported excel
   Dim ProductStart As String
   ProductStart = "ID"
   Dim ProductEnd As String
   ProductEnd = "TOTAL"

   'Range where ProductData is located
    Dim ID_rng As Range
    Set ID_rng = Sheets("Input_data").Range("A:A")


    'Find ProductData from Product_rng and make it as Product_Range

Dim Product_Range As Range
Set Product_Range = ID_rng.Find(what:=ProductStart)

 'Dim Product_End_Range As Range
   'Set Product_End_Range = ID_rng.Find(what:=ProductEnd)

   'Define_Calculation template as sheet
    Dim Template_sht As Worksheet
   Set Template_sht = ThisWorkbook.Sheets("Template")

   'Make new sheet for Product with tempalate and fill the values.

    'Define ProductStart location as First cell. This is the starting point of each product.
    Dim FirstCell As String

    FirstCell = Product_Range(1, 1).Address

    Do

    MsgBox Product_Range.Address
   'MsgBox Product_End_range.Address

    'Define Product values
    Dim Product_ID As Range
     Set Product_ID = Product_Range(2, 1)

     Dim Product_Name As Range
     Set Product_Name = Product_Range(2, 2)
     Dim Product_Weight As Range
     Set Product_Weight = Product_Range(2, 4)
     Dim Product_Width As Range
     Set Product_Width = Product_Range(2, 5)
     Dim Product_Height As Range
     Set Product_Height = Product_Range(2, 6)

     'Define product specific data range
       Dim Product_data As Range
       Set Product_data = Range(Product_ID(2, 1),               
   Cells(Sheets("Input_data").Range("A:A").Find(what:=ProductEnd).Row - 1, 6))
       MsgBox Product_data.Address

    Template_sht.Copy After:=Sheets(Sheets.Count)

    Sheets(Sheets.Count).Name = Product_ID.Value

'Error handling if dublicated product IDs occure while creating sheets. Application will stop
  On Error GoTo Error_ProductID


Application.ScreenUpdating = False

 With Sheets(Product_ID.Value)
'Copies the Product_ID value to Template cell C2
                .Range("C2").Value = Product_ID.Value
'Copies the Product_Name value to Template cell A2
                .Range("A2").Value = Product_Name.Value
'Copies the Weight value to Template cell F1
                .Range("F1").Value = Product_Weight.Value
'Copies the Width value to Template cell F2
                .Range("F2").Value = Product_Width.Value
'Copies the Height value to Template cell F3
                .Range("F3").Value = Product_Height.Value
  
                
      End With
   Set Product_Range = ID_rng.FindNext(Product_Range)

   Loop While FirstCell <> Product_Range(1, 1).Address


    MsgBox "Sheets Created"

   End With
   Application.ScreenUpdating = True

   End If

   ThisWorkbook.Sheets("Input_data").Activate

   Exit Sub

   Error_ProductID:
   MsgBox "Dublicated productID. Check Product IDs for dublicates, correct and try again.               
   Check Product ID" & " " & Product_ID.Value

   ThisWorkbook.Sheets("Input_data").Activate

   Application.ScreenUpdating = True

   End Sub

user_14608750 · Answer

On this line:Set Product_data = Range(Product_ID(2, 1), Cells(Sheets("Input_data").Range("A:A").Find(what:=ProductEnd).Row - 1, 6))

You need to use the parameter After to tell the method to start searching from Product_Range and not from the top of the column. If it always searches from the top of the column, it will always find the first "TOTAL" and not the "TOTAL" associated with the current data set.

It would also be a good idea to directly include the parent worksheet for the range you are creating with Range and Cells. If the parent worksheet isn't written, it defaults to ActiveSheet. It's best to write the parent sheet, preventing errors where the wrong sheet is active, and your macro starts creating ranges on sheets you didn't expect.

With Worksheets("Input_data")
    Set Product_data = .Range(Product_ID(2, 1), _
        .Cells(Sheets("Input_data").Range("A:A").Find(what:=ProductEnd, After:=Product_Range).Row - 1, 6))
End With

How to define a range inside the loop using find in VBA

1 Answers