Select, Copy and paste to another Tab Based on Cell content

[bradjedis]

Greetings!

I have a workbook, where I initially import the "raw data". Once I have the raw data, I sort based on column D.

I would like to grab all of the cell data in tab Raw Data, from A2 thru AB2, continuing down until the contents of cell D change. then copy that data into a tab called "first". Then when the data in column D changes, grab that set of data (same pattern), and paste in to a tab called "second". The target cell for both tabs will be A2.

Ideas?


thanks,
Brad

[HansV]

Naming sheets "first", "second" etc. is a bit difficult - we'd have to teach VBA how to count in words. That's definitely possible, but it seems overkill. Let me know if you really need it.

The version below names the sheets Data1, Data2 etc.

Code: Select all

Sub SplitData()
    Const FirstRow = 2
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim CurRow As Long
    Dim LastRow As Long
    Dim StartRow As Long
    Dim Counter As Long
    Dim NewName As String

    Application.ScreenUpdating = False
    Set Source = Worksheets("Raw Data")
    LastRow = Source.Range("D" & Source.Rows.Count).End(xlUp).Row
    StartRow = FirstRow
    For CurRow = FirstRow To LastRow
        If Source.Range("D" & CurRow).Value <> Source.Range("D" & CurRow + 1).Value Then
            Counter = Counter + 1
            NewName = "Data" & Counter
            Set Target = Nothing
            On Error Resume Next
            Set Target = Worksheets(NewName)
            On Error GoTo 0
            If Target Is Nothing Then
                Set Target = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                Target.Name = NewName
            Else
                Target.UsedRange.ClearContents
            End If
            Source.Range("A" & StartRow & ":AB" & CurRow).Copy _
                Destination:=Target.Range("A2")
            StartRow = CurRow + 1
        End If
    Next CurRow
    Application.ScreenUpdating = True
End Sub

[bradjedis]

Ok.. I will give it a try as is... I will need to train myself on what data 1, data 2, etc... really mean...


Thanks!

[HansV]

The code that I posted assumes that there might be many different values. If there are really only two values, using "first" and "second" wouldn't be a problem, of course.

[bradjedis]

Actually, it works great. However, once the tabs for Data(x) are populated, I then copy the data to the intended tabs. then use VBA to delete the Data(x) tabs. I get the dialog box informing me about "you cannot undo...." How can I thru VBA address this dialog box, and 'click' the Delete button?


see attached....file please.

Thanks,
Brad

[HansV]

Above the lines that delete the sheets, insert the line

Code: Select all

    Application.DisplayAlerts = False

and below them, insert the line

Code: Select all

    Application.DisplayAlerts = True

Setting DisplayAlerts to False hides dialog boxes such as the one you show, and presses the 'default' button for you.

[bradjedis]

worked great!

[bradjedis]

Hans,

with using the code above to parse the raw data into the Data(x) worksheets, I find that I will not always have the Same information in the Data1 sheet, as the content of the raw data will change and not necessarily have the Same types. Meaning the I may have More, or Fewer identifiers in column D.

I have found some code that kind of addresses the need for me to change the Sheet Names for the Data(x) sheets to something meaningful, but it does not seem to address the renaming since the names are not Sheet1, etc...but Data1, Data1, etc...

This is what I have found (so far)... Any thoughts?

Sub RenameTabs()

For x = 1 To Sheets.Count
If Worksheets(x).Range("D2").Value <> "" Then
Sheets(x).Name = Worksheets(x).Range("D2").Value
End If
Next
End Sub

[HansV]

This code should rename ALL sheets to the text found in cell D2 of that sheet, unless D2 is empty.
You can use another cell, of course, simply modify the code to use that cell instead of D2.

[bradjedis]

Right. However I have a couple of Sheets, such as the Raw data sheet, and another I use for Vlookup, that need to remain as named...

[HansV]

You can exclude some sheets:

Code: Select all

Sub RenameTabs()
    Dim wsh As Worksheet
    For Each wsh In Worksheets
        Select Case wsh.Name
            Case "Raw", "Another", "PerhapsThis"
                ' Ignore these
            Case Else
                If wsh.Range("D2").Value <> "" Then
                    wsh.Name = wsh.Range("D2").Value
                End If
        End Select
    Next wsh
End Sub

[bradjedis]

Sweet.. Exactly what I needed.....

Many thanks