Dynamic row selection based on condition

HI everyone,

I just got started with VBA and I have a challenging macro to program. I would appreciate if you could help me or give me a hint how to do the following.

I have a table that looks like this:

prices quantities Company
1 5 ABC Company
3 45 ABC Company
4 6 ABC Company
6 3 CDF Company
34 2 GHI Company
43 4 GHI Company

I would like to copy all rows (A1:C3) for ABC company in one worksheet, all rows for CDF in another worksheet and all rows for GHI company in a third worksheet. Here is the catch. Every week this table is updated and the names and frequence of the company change. For example in week two there is only one row for ABC company, no CDF company and 5 rows for GHI company. Is there any chance to code that in VBA?

I started and I created the following:

Sub Copy_data()

    Workbooks("data 20110427.xls").Sheets("Refined data").Activate
   
    If Range("C" + i) = Range("C" & (i + 1)) Then
    Range("A" & i & ":C" & i).Select
    Selection.Copy
    Workbooks("M.xls").Activate
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
Next
End Sub

However this setup far from complete and it would ignore the last row of every company.

Any ideas?

Thanks a lot!

Hello Hornet222,

This macro will either create a new sheet with the company's name or append that company's data to the existing sheet. The macro assumes the company's name is in column "C" and the first row on the main sheet contains the headers.

'Written: April 27, 2011
'Author:  Leith Ross
'Summary: Copies data defined as a group to another worksheet in the workbook.
'         A specified column or columns is used to generate the group name. If
'         a worksheet exits with this name then data is appended. If no sheet by
'         that name exists then a new sheet is created using this name.
'
'NOTES:   The first row of the data, regardless of the physical worksheet row number,
'         is assumed to contain headers. This header information is copied over to
'         a worksheet if the first available row is empty.

Sub CopyDataGroupToSheet()

  Dim DstWks As Worksheet
  Dim Headers As Range
  Dim NextRow As Range
  Dim R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SrcWks As Worksheet
  Dim WksName As String
  
   'Assign the Source Worksheet variable.
    Set SrcWks = Worksheets("Sheet1")
    
    Set Headers = SrcWks.UsedRange.Rows(1)
    
    Set Rng = Headers.Offset(1, 0)
    Set RngEnd = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = SrcWks.Range(Rng, RngEnd)
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
      For R = 1 To Rng.Rows.Count
      
       'Assign the Destination Worksheet variable.
       'Here the second column holds the destination worksheet name.
        WksName = Rng.Cells(R, "C")
        
       'Check if the worksheet exists or not. If not, add a new sheet with the headers.
        If WksName <> SrcWks.Name Then
           On Error Resume Next
           Set DstWks = Worksheets(WksName)
             If Err <> 0 Then
                Worksheets.Add After:=Worksheets(Worksheets.Count)
                ActiveSheet.Name = WksName
                Set DstWks = ActiveSheet
                Err.Clear
             End If
           On Error GoTo 0
           
          'Add the headers if this is the first row and its empty.
           Set NextRow = DstWks.Cells(Rows.Count, "A").End(xlUp)
             If NextRow.Row = 1 And NextRow = "" Then
                Headers.Copy NextRow
             End If
           
          'Copy the data to next free row on the worksheet.
           Set NextRow = NextRow.Offset(1, 0)
           Rng.Rows(R).Copy NextRow
        End If
      Next R
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub