How do I use a cell's value to open a specific sheet?

Question

First, thanks for helping! I am learning how to use VBA and having fun doing so, but now I've hit a bump, I hope your expertise can aid me in my time of need.

Background: I have data in a table, where I compare two columns J and T.

If these values are equal, then copy that row, row i, into the sheet which has the name of the cells just checked, Cell(i, J) or Cell (i, T).

If these values are not equal, then copy that row, row i, into the sheet which has the name of the cells just checked, Cell(i, J) and Cell (i, T).

The values which J and T can take include A2B, APL, BGF, CMA, among others (see code).

Example: Compare J2 and T2,

Suppose J2=T2=BGF then copy row 2 and paste into sheet(BGF)

Next, compare J3 and T3

Suppose J3=BGF and T3=CMA, copy row 3 and paste into sheet(BGF) and sheet(CMA)

CODE

Sub Sortdata()
'step 1 clear all data
Sheets("A2B").Cells.ClearContents
Sheets("APL").Cells.ClearContents
Sheets("BGF").Cells.ClearContents
Sheets("CMA").Cells.ClearContents
Sheets("K Line").Cells.ClearContents
Sheets("MacAndrews").Cells.ClearContents
Sheets("Maersk").Cells.ClearContents
Sheets("OOCL").Cells.ClearContents
Sheets("OPDR").Cells.ClearContents
Sheets("Samskip").Cells.ClearContents
Sheets("Unifeeder").Cells.ClearContents

' Look at rows J and T, if the values are equal then copy row i to sheet "Cell( i , J )".
' Else, copy row i to sheet(Cell( i , J )) and sheet(Cell ( i , T ))             [Value.Ji and Value.Ti]

Sheets("All Data").Select

Dim i As Integer

For i = 2 To 10000
    If Worksheets("All Data").Range("J" & i) = Worksheets("All Data").Range("T" & i) Then 'if two cells are equal

        Worksheets("All Data").Rows(i).Select 'then select the row
        Selection.Copy
        Worksheets("All Data").Rows(i).Copy 'copy the data
        Worksheets(Sheets("All Data").Range("J" & i).Value).End(xlUp).Select 'open the new worksheet using the cell value Ji as the sheet name
        Selection.Offset(1, 0).Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.

        Else
        Worksheets("All Data").Rows(i).Select
        Selection.Copy
        Worksheets("All Data").Rows(i).Copy
        Worksheets(Sheets("All Data").Range("J" & i).Value).End(xlUp).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats

        Worksheets("All Data").Rows(i).Select
        Selection.Copy
        Worksheets("All Data").Rows(i).Copy
        Worksheets(Sheets("All Data").Range("T" & i).Value).End(xlUp).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats

    End If
Next i

End Sub

PROBLEM: It all works well, until this line, I cant get the syntax right to reference the cell from the "All Data" sheet ```Worksheets(Sheets("All Data").Range("J" & i).Value).End(xlUp).Select``` — Joshua, Jan 15 '20 at 20:05
That line is looking for a worksheet named according to the contents of the cell `Sheets("All Data").Range("J" & i).Value`. Does that cell contain something which could be interpreted as a sheet name? If so, the probem is that `end(xlup)` needs to apply to a range not a worksheet. — SJR, Jan 15 '20 at 20:32
So something like `Worksheets(Sheets("All Data").Range("J" & i).Value).range("A" & rows.count).End(xlUp).Select` would work but you should read https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — SJR, Jan 15 '20 at 20:35
Hi SJR, cheers for getting on this! The Else and If case want to be similar, in the ```If``` case I want to copy to just one sheet, in the ```Else``` case I want to copy the row to both sheets. ```Worksheets(Sheets("All Data").Range("J" & i).Value).range("A" & rows.count).End(xlUp).Select``` gives 1004, select method of range class failed :( — Joshua, Jan 15 '20 at 20:46

SJR · Answer 1 · 2020-01-17T11:07:27.800

0

See if this works. You can see how much the code can be shortened by avoiding Select.

Sub Sortdata()

'code to clear sheets

Dim i As Long

With Worksheets("All Data")
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        If Len(.Range("J" & i)) > 0 And Len(.Range("T" & i)) > 0 Then
            .Rows(i).Copy
            Worksheets(.Range("J" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.
            If .Range("J" & i) <> .Range("T" & i) Then
                .Rows(i).Copy
                Worksheets(.Range("T" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            End If
        End If
    Next i
End With

End Sub

edited Jan 17 '20 at 11:07

answered Jan 15 '20 at 20:42

SJR

22,986
6
18
26

This code looks beautiful now! I'm going to try this now, I am reading the select thread too. – Joshua Jan 15 '20 at 20:50
Yes, get in the habit of indenting your code too and it looks much more readable. This code could be shortened as the first bit can be taken out of the If. – SJR Jan 15 '20 at 20:52
Error 9: Subscript out of range ```Worksheets(.Range("J" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats``` unfortunately it's not worked here – Joshua Jan 15 '20 at 20:54
The value in J does not equate to a worksheet in the file? – SJR Jan 15 '20 at 20:57
The workbook has 8 sheets: Home, All Data, A2B, APL, BGF, CMA, K Line, OOCL. Column J and Column T have values equal to A2B,APL,BGF,CMA,K Line&OOCL, J and T may also be empty. – Joshua Jan 15 '20 at 21:01
J and T are always one of those, never anything else – Joshua Jan 15 '20 at 21:02
You need to check they're not empty. – SJR Jan 15 '20 at 21:03
i have put in values to all cells J2:J20 and T2:T20. It sorts them all then hits a run time error rather than stopping the process. – Joshua Jan 15 '20 at 21:06
I just tested with other data, it works until one cell is empty, then it throws up the fault. if all cells are filled then it carries on to the end of the data set then throws up the run time error... SJR, this progress has amazed me, where did you learn VBA? – Joshua Jan 15 '20 at 21:09
With the following data: J2=BGF, J3=A2B, J4= "empty", K2=BGF, J3=CMA, J4=CMA. Row 2 is copied to Sheet BGF, row 3 to A2B and CMA, row 4 does not pass the VBA. Over and Out for tonight @SJR – Joshua Jan 15 '20 at 21:39
So on a loop of 2 to 20 it fails at the end? I'll pick it up tomorrow. – SJR Jan 15 '20 at 22:09
Correct, if J2:J20 and T2:T20 all have values, the program seems to continue running then giving a run time error. thnx – Joshua Jan 15 '20 at 22:21
So what error message do you get, on which line, and does the code work properly otherwise? – SJR Jan 16 '20 at 10:23
So there I have tested for three different scenarios. If all cells for J and T have values then the program runs to the end of these pairs, then recognises that empty J = empty T. then throws out the error: run time error '9' subscript out of range. error on -->```Worksheets(.Range("J" & i).Value)...``` Second, if Ji is empty but Ti is filled, then it recognises that Ji is not equal Ti, then throws out the error: run time error '9' subscript out of range, on second worksheet line. The same happens for when Ji is filled, but Ti is empty error on third worksheets line – Joshua Jan 16 '20 at 20:55
When testing with live data, the code does not check for when only Ji has a value. In this case, information is, incorrectly, not copied to the corresponding sheet – Joshua Jan 20 '20 at 12:04

How do I use a cell's value to open a specific sheet?

1 Answers1