Results 1 to 6 of 6

Thread: Copying row into different worksheet based on string in cell

  1. #1
    Neophyte amanda_hemi's Avatar
    Join Date
    Nov 2018
    Posts
    3
    Articles
    0
    Excel Version
    Excel 16 i believe

    Smile Copying row into different worksheet based on string in cell



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello,

    I have experience in R but none with VBA. I have been looking for a way to copy a row of data into a different worksheet based on a string of characters within the cell.

    I have looked and have found parts to my problem but can't seem to combine them all together to work.
    Click image for larger version. 

Name:	forum.PNG 
Views:	6 
Size:	4.1 KB 
ID:	8601
    The above is an example of how my data is set up. I want to sort the styles that start with an A or S to be sorted into a worksheet "Sport", the styles that dont start with A, or S, that contain 01-, 02-,... 09- to be copied onto a worksheey called "Bags", and stlyle that contains 10- to be copied to a worksheet called wallets.

    I was looking into doing a for loop with if then statements, but I can't get it all to work together.

  2. #2
    Acolyte alansidman's Avatar
    Join Date
    Oct 2018
    Location
    Steamboat Springs
    Posts
    39
    Articles
    0
    Excel Version
    2016
    Code:
    Option Explicit
    
    
    Sub Amanda()
        Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet
        Set s1 = Sheets("Main")    'change this to whatever your primary sheet is named
        Set s2 = Sheets("Sport")
        Set s3 = Sheets("Bags")
        Set s4 = Sheets("Wallets")
        Dim i As Long, lr As Long, lr2 As Long, lr3 As Long, lr4 As Long
        Application.ScreenUpdating = False
        lr = s1.Range("B" & Rows.Count).End(xlUp).Row
        For i = 2 To lr
            lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row + 1
            lr3 = s3.Range("B" & Rows.Count).End(xlUp).Row + 1
            lr4 = s4.Range("B" & Rows.Count).End(xlUp).Row + 1
            If InStr(s1.Range("B" & i), "A") = 1 Or InStr(s1.Range("B" & i), "S") = 1 Then
                s1.Range("A" & i & ":C" & i).Copy s2.Range("A" & lr2)
            ElseIf s1.Range("B" & i) Like "0" & Chr(42) & "-" & Chr(42) Then
                s1.Range("A" & i & ":C" & i).Copy s3.Range("A" & lr3)
            ElseIf InStr(s1.Range("B" & i), "10-") > 0 Then
                s1.Range("A" & i & ":C" & i).Copy s4.Range("A" & lr4)
            End If
        Next i
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        MsgBox "complete"
    End Sub

  3. #3
    Neophyte amanda_hemi's Avatar
    Join Date
    Nov 2018
    Posts
    3
    Articles
    0
    Excel Version
    Excel 16 i believe
    Hello,

    Thank you so much! I edited to work more specifically to what I need but I am getting an error code "Subscript out of Range".

    I am not sure how to fix this, because I cant identify what is wrong.

    Option Explicit




    Sub OTS()
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet, s5 As Worksheet, s6 As Worksheet, s7 As Worksheet, s8 As Worksheet

    Set s1 = Sheets("OTS") 'change this to whatever your primary sheet is named
    Set s2 = Sheets("HANDBAG")
    Set s3 = Sheets("SPORT")
    Set s4 = Sheets("COSMETIC")
    Set s5 = Sheets("FANNY")
    Set s6 = Sheets("Wallet")
    Set s7 = Sheets("DIAPER BAG")
    Set s8 = Sheets("PHONE CASE")

    Dim i As Long, lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, lr8 As Long
    Application.ScreenUpdating = False
    lr = s1.Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
    lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row + 1
    lr3 = s3.Range("B" & Rows.Count).End(xlUp).Row + 1
    lr4 = s4.Range("B" & Rows.Count).End(xlUp).Row + 1
    lr5 = s5.Range("B" & Rows.Count).End(xlUp).Row + 1
    lr6 = s6.Range("B" & Rows.Count).End(xlUp).Row + 1
    lr7 = s7.Range("B" & Rows.Count).End(xlUp).Row + 1
    lr8 = s8.Range("B" & Rows.Count).End(xlUp).Row + 1
    If InStr(s1.Range("B" & i), "A") = 1 Or InStr(s1.Range("B" & i), "S") = 1 Then
    s1.Range("A" & i & ":E" & i).Copy s3.Range("A" & lr2)
    ElseIf s1.Range("B" & i) Like "0" & Chr(42) & "-" & Chr(42) Or InStr(s1.Range("B" & i), "12-") > 0 Or InStr(s1.Range("B" & i), "19-") > 0 Then
    s1.Range("A" & i & ":E" & i).Copy s2.Range("A" & lr3)
    ElseIf InStr(s1.Range("B" & i), "10-") > 0 Then
    s1.Range("A" & i & ":E" & i).Copy s6.Range("A" & lr4)
    ElseIf InStr(s1.Range("B" & i), "14-") > 0 Then
    s1.Range("A" & i & ":E" & i).Copy s4.Range("A" & lr5)
    ElseIf InStr(s1.Range("B" & i), "15-") > 0 Then
    s1.Range("A" & i & ":E" & i).Copy s5.Range("A" & lr6)
    ElseIf InStr(s1.Range("B" & i), "17-") > 0 Then
    s1.Range("A" & i & ":E" & i).Copy s7.Range("A" & lr7)
    ElseIf InStr(s1.Range("B" & i), "18-") > 0 Then
    s1.Range("A" & i & ":E" & i).Copy s8.Range("A" & lr8)
    End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
    End Sub

  4. #4
    Neophyte amanda_hemi's Avatar
    Join Date
    Nov 2018
    Posts
    3
    Articles
    0
    Excel Version
    Excel 16 i believe
    I figured it out! Thank you so much for your help!! Can I ask one last question? I want to sum my last column, but the number of rows I have will be changing, what sort of range can I use? Is there a stop method I can use when the sum reaches an empty cell? TIA

  5. #5
    Acolyte alansidman's Avatar
    Join Date
    Oct 2018
    Location
    Steamboat Springs
    Posts
    39
    Articles
    0
    Excel Version
    2016
    Code:
    Option Explicit
    
    
    Sub SumItUp()
        Dim lr As Long, x As Double
        lr = Range("A" & Rows.Count).End(xlUp).Row    'Change the A to your column
        x = WorksheetFunction.Sum(Range("A1:A" & lr))
        MsgBox ("Total is " & x)
    End Sub

  6. #6
    Wizard Pecoflyer's Avatar
    Join Date
    Oct 2011
    Location
    Brussels Belgium
    Posts
    1,504
    Articles
    0
    Excel Version
    2010 on Xubuntu
    @amanda
    Hi,
    When posting code, please wrap it with code tags ( Edit code - select code - click the #button.)
    It keeps the macro's structure and makes it easy to copy and handle.
    Thank you
    Thank you Ken for this secure forum.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •