Want to Distribute Data from Sheet A to the other sheets based on Criteria

[jordan1214]

So, what I am trying to do is move/copy each row from the "database" sheet and distribute them to the other sheets (C,1B,2B,SS,3B,OF).

I will be copying and pasting data into "database", I would like to distribute them based on the matching data in Column B. (Column B data matches what sheet it will be sent to)

I believe this is a macro issue, and I'm not sure how to set up something so that I will be able to continually update the "Database" sheet and have it keep moving the rows to the appropriate sheet.

Thanks so much for the help in advance.

[jordan1214]

I added a second worksheet (Sample12) that includes data in the "Database" sheet in case that is needed in order to get this formula/macro working.

[FDibbins]

Please do not post duplicate threads. I see that all you did was add some text to post #1 - next time, just use the "edit" feature.

I have closed your other post, you can continue on this 1

[jordan1214]

Thanks, I am not sure if the issue is a formula or macro problem so didn't know which thread to post it in

[Trebor76]

What about my code that I posted for you, which you never bothered to reply to, here?

[jordan1214]

What about my code that I posted for you, which you never bothered to reply to, here?

I don't know how to use that information, if you are interested in helping feel free to look above and let me know how to use the code that you posted. The others just sent me a new workbook, I'm just trying to learn all this.

[FDibbins]

jordan, how is this thread any different to the 1 that Trebor was *trying* to help you on, and which you seem to have then completely ignored his suggestion?

Even if you did not know how to use his code, the very LEAST you could have done was to acknowledge the effort he put into writing that code for you

[jordan1214]

And by the way, any time anyone has ever helped me, I am sure you can see I thanked them and added to their reputation. It sucks that this thread had to be ruined as it would be great to get an idea how to do what I am trying to do.

[jordan1214]

I missed the response, sorry. This is out of hand, I am just going to start a new thread in the other spot where I received help last time because there is plenty of discussion that is not even related.

[jordan1214]

And to answer your other question, this thread is different. Every sheet has a different name, different data points. The idea is the same but I never found out how to do it in the first place, and if anything I want to receive help on what I am currently posting. Backtracking is not going to help, I apologized for not responding to an answer that I never saw. Not sure what else you want me to do, but clearly it isn't enough.

[Trebor76]

I don't know how to use that information

That's a worry in that the code is virtually the same

That said, try this:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim varMyTabLen As Variant
    Dim lngMyRow As Long
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Sheets("Database").Range("A2", Range("A" & Rows.Count).End(xlUp))
    
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then
                If WorksheetFunction.CountA(CStr(rngCell)) = 0 Then
                    lngMyRow = 2 'Default row number if there's no data. Change to suit.
                Else
                    lngMyRow = Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                End If
            Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":E" & lngMyRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":F" & rngCell.Row).Value
            End If
            Err.Clear
        On Error GoTo 0
    
    Next rngCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is complete"
    
End Sub

Robert

[jordan1214]

That's a worry in that the code is virtually the same

That said, try this:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim varMyTabLen As Variant
    Dim lngMyRow As Long
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Sheets("Database").Range("A2", Range("A" & Rows.Count).End(xlUp))
    
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then
                If WorksheetFunction.CountA(CStr(rngCell)) = 0 Then
                    lngMyRow = 2 'Default row number if there's no data. Change to suit.
                Else
                    lngMyRow = Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                End If
            Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":E" & lngMyRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":F" & rngCell.Row).Value
            End If
            Err.Clear
        On Error GoTo 0
    
    Next rngCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is complete"
    
End Sub

Robert

thank you for posting the code again, however I am not aware of how to use that, care to share something I can google to find out how to put that to use?

[FDibbins]

The tread is not ruined, so please do not post *another* duplicate thread, im sure if you continue here, you will get the help you wanted.

Pesonally, I cannot see how you can post a question, then "miss the response" and then repost pretty much the same thread...but thats just me.

good luck and I hope you getthe answers you are looking for

[Trebor76]

Hi jordon1214,

I've included my macro on the attached, to run it simply press Alt + F8 (i.e. press and hold Alt the press F8), click on Macro1 and then click Run.

Robert

[jordan1214]

Hi jordon1214,

I've included my macro on the attached, to run it simply press Alt + F8 (i.e. press and hold Alt the press F8), click on Macro1 and then click Run.

Robert

Thank you for the response. So everytime I add new data to the "Database" sheet, I can just re-run this?

[jordan1214]

I haven't got to try with my big samples yet, but it looks like re-running it is as easy as it sounds. Wow, I can't thank you enough. I will come back and add more reputation once it allows me too. This was a really big help.

[jordan1214]

So this is my last question, then I will mark this solved. Will I be able to add/edit new rows of data (for example, I will have at least rowsC-R of data, and in my example it only has Rows C-F marked with "Data") in the original "database" sheet or will that mess up the macro code?

[jordan1214]

It looks like that is an issue. So if I take this line of the code:

" lngMyRow = Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End If
Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":E" & lngMyRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":F" & rngCell.Row).Value "



Range("A:E") = Range of C/1B/2B/3B/SS/OF sheets?

("A" & lngMyRow & ":E" & lngMyRow) = Range of C/1B/2B/3B/SS/OF sheets?
("B" & rngCell.Row & ":F" & rngCell.Row) = Database Info Range to Pull?

[jordan1214]

It looks like that is going to work. Is it okay if I leave this open for the next day or so while I mess around with this new stuff?

[Trebor76]

Hi jordon1214,

Replace my existing code with this (post back if you're not sure how to do):

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim varMyTabLen As Variant
    Dim lngStartRow As Long
    Dim lngMyRow As Long
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    lngStartRow = 2 'Initial data row. Change to suit.
    
    For Each rngCell In Sheets("Database").Range("A" & lngStartRow, Sheets("Database").Range("A" & Rows.Count).End(xlUp))
    
        'Clear any existing data to prevent data duplication
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then 'Only try and clear any existing entries if the tab exists
                If WorksheetFunction.CountA(CStr(rngCell)) > 0 Then
                    If Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row >= 2 Then
                        Sheets(CStr(rngCell)).Range("A" & lngStartRow & ":E" & Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).ClearContents
                    End If
                End If
            End If
            Err.Clear
        On Error GoTo 0
        
    Next rngCell
    
    For Each rngCell In Sheets("Database").Range("A" & lngStartRow, Sheets("Database").Range("A" & Rows.Count).End(xlUp))
    
        'Populate tabs
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then 'Only populate sheets if the tab exists
                If WorksheetFunction.CountA(CStr(rngCell)) = 0 Then
                    Sheets(CStr(rngCell)).Range("A" & lngStartRow & ":E" & lngStartRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":F" & rngCell.Row).Value
                Else
                    lngMyRow = Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":E" & lngMyRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":F" & rngCell.Row).Value
                End If
            End If
            Err.Clear
        On Error GoTo 0
    
    Next rngCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is complete"
    
End Sub

Robert

[Trebor76]

The lngMyRow variable finds the last row from Col's A to E (inclusive) from the relevant individual tab and increments this by one. This row is then used to populate that tab with the row from the rngCell variable (Col's B to F) from the Database tab.

My latest code will continually update the individual tabs from the Database tab.

HTH

Robert

[jordan1214]

4:13 AM MACRO.xlsmWow, thank you for taking the time to continue to help. I have not stopped messing with this as I am now able to sample everything I need to.

I have run into one more issue. Each time I try and edit the file you sent me, and then try and save it, it doesn't allow it and says it's read only. So I tried to make a copy, then tried editing and saving, and same thing. Am I just making a stupid error or is there something going on?

[Trebor76]

Not sure what's happening re the saving of the workbook

As long as you doing a Save As > Excel Macro-Enabled Workbook (it will have an "xlsm" extension) on the file I can't see any issue. I'd suggest getting that sorted before you do any editing so you don't lose any work.

[Trebor76]

Based on the assumption you want columns B:AB of the Database tab into columns A:AA of the corresponding tab, try this:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim varMyTabLen As Variant
    Dim lngStartRow As Long
    Dim lngMyRow As Long
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    lngStartRow = 2 'Initial data row. Change to suit.
    
    For Each rngCell In Sheets("Database").Range("A" & lngStartRow, Sheets("Database").Range("A" & Rows.Count).End(xlUp))
    
        'Clear any existing data to prevent data duplication
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then 'Only try and clear any existing entries if the tab exists
                If WorksheetFunction.CountA(CStr(rngCell)) > 0 Then
                    If Sheets(CStr(rngCell)).Range("A:AA").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row >= 2 Then
                        Sheets(CStr(rngCell)).Range("A" & lngStartRow & ":AA" & Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).ClearContents
                    End If
                End If
            End If
            Err.Clear
        On Error GoTo 0
        
    Next rngCell
    
    For Each rngCell In Sheets("Database").Range("A" & lngStartRow, Sheets("Database").Range("A" & Rows.Count).End(xlUp))
    
        'Populate tabs
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then 'Only populate sheets if the tab exists
                If WorksheetFunction.CountA(CStr(rngCell)) = 0 Then
                    Sheets(CStr(rngCell)).Range("A" & lngStartRow & ":AA" & lngStartRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":AB" & rngCell.Row).Value
                Else
                    lngMyRow = Sheets(CStr(rngCell)).Range("A:AA").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":AA" & lngMyRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":AB" & rngCell.Row).Value
                End If
            End If
            Err.Clear
        On Error GoTo 0
    
    Next rngCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is complete"
    
End Sub

You could also look at simply filtering the data in the Database tab as individual tabs are often the least efficient way of doing things.

HTH

Robert

[jordan1214]

Based on the assumption you want columns B:AB of the Database tab into columns A:AA of the corresponding tab, try this:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim varMyTabLen As Variant
    Dim lngStartRow As Long
    Dim lngMyRow As Long
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    lngStartRow = 2 'Initial data row. Change to suit.
    
    For Each rngCell In Sheets("Database").Range("A" & lngStartRow, Sheets("Database").Range("A" & Rows.Count).End(xlUp))
    
        'Clear any existing data to prevent data duplication
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then 'Only try and clear any existing entries if the tab exists
                If WorksheetFunction.CountA(CStr(rngCell)) > 0 Then
                    If Sheets(CStr(rngCell)).Range("A:AA").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row >= 2 Then
                        Sheets(CStr(rngCell)).Range("A" & lngStartRow & ":AA" & Sheets(CStr(rngCell)).Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).ClearContents
                    End If
                End If
            End If
            Err.Clear
        On Error GoTo 0
        
    Next rngCell
    
    For Each rngCell In Sheets("Database").Range("A" & lngStartRow, Sheets("Database").Range("A" & Rows.Count).End(xlUp))
    
        'Populate tabs
        On Error Resume Next
            varMyTabLen = Len(Sheets(CStr(rngCell)).Name)
            If Err.Number = 0 Then 'Only populate sheets if the tab exists
                If WorksheetFunction.CountA(CStr(rngCell)) = 0 Then
                    Sheets(CStr(rngCell)).Range("A" & lngStartRow & ":AA" & lngStartRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":AB" & rngCell.Row).Value
                Else
                    lngMyRow = Sheets(CStr(rngCell)).Range("A:AA").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Sheets(CStr(rngCell)).Range("A" & lngMyRow & ":AA" & lngMyRow).Value = Sheets("Database").Range("B" & rngCell.Row & ":AB" & rngCell.Row).Value
                End If
            End If
            Err.Clear
        On Error GoTo 0
    
    Next rngCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is complete"
    
End Sub

You could also look at simply filtering the data in the Database tab as individual tabs are often the least efficient way of doing things.

HTH

Robert

Thank you Robert that is exactly what I was hoping it would look like!

What do you mean by filtering the data? I would love to have things become more efficient always. I understand I can sort from the "database" but don't know what you mean by filter. Thanks again!

[Trebor76]

What do you mean by filtering the data

To filter your data just follow these two steps:

1. Select the Database tab and then select cell A1
2. From the Sort & Filter tab in Data ribbon click Filter

Click the down arrows at the right of each heading in row 1 to filter the data as required.

HTH

Robert

[jordan1214]

To filter your data just follow these two steps:

1. Select the Database tab and then select cell A1
2. From the Sort & Filter tab in Data ribbon click Filter

Click the down arrows at the right of each heading in row 1 to filter the data as required.

HTH

Robert

Thank you, I will now mark this closed as you have been very helpful.

[Trebor76]

Thanks for the feedback and I'm glad we were able to provide a solution