Consulting

Results 1 to 19 of 19

Thread: Need Help Wrting This. (If from list, Then, If blanks, New Column)

  1. #1

    Need Help Wrting This. (If from list, Then, If blanks, New Column)

    Hi, I'm new to Excel and VBA. I'm trying to learn on my own but have yet to find a answer for a way to accomplish what I'm trying to do.

    I have one sheet in column(A) I have multiple words in different cells. In my example it is names and fruits.
    I want to be able to separate the words into there own separate sheet if the word appears.
    I also need it to separate the words into a different column in its appropriate sheet if a blank cell is shown.

    I'm attach a example excel file.

    In my example in column A-
    Bill
    Bob
    Kiwi
    Hank
    Harry
    Fred
    Bill
    Apple
    Kiwi
    Hank
    Harry
    Mike
    Orange
    John
    Fred

    I need Bill, Bob, Hank, Harry, Fred to go to a sheet named 'Names" into column A - Kiwi Will go to its own separate sheet named "Fruit" in column A
    Because there is a blank cell in between my information. I need to to move over a column in their appropriate sheets
    Bill, Hank, Harry will go to sheets named "names" and now to column B. Apple, and Kiwi will move to Sheet "Fruit" and into column B
    Mike, John Fred- Sheet "Names" Column C. Orange to sheet "Fruit" column C.

    I need this to continue on for as long as possible because I don't know how much information I will have in the original sheet where all there information is in Column A.

    I hope how I'm explaining this makes sense, and I'm sure will all your bright minds, someone will be able to tackle this challenge for me.

    Thanks
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Although it's quite easy for us humans to tell the diffrence between fruit and names. the computer hasn't a hope without complete lists of what are names and what are fruit.
    I say quite easy; but it isn't necessarily that easy; what do you do with the likes of Cherry, Apple (Gyneth Paltrow daughter), Olive, Huckleberry (Finn), Kiwi, Damson, Cerise, Peach, Clementine (Churchill), all of which are names and fruit?
    Another way is to mark (in an adjcent column in Sheet1) those items which are names, or those which are fruit.. or both.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by p45cal View Post
    Although it's quite easy for us humans to tell the diffrence between fruit and names. the computer hasn't a hope without complete lists of what are names and what are fruit.
    I might have goofed here; could the sheet tab List be those lists? or is that sheet to be generated too?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    p45Cal, I understand what you're saying, In the attached file called example I have a separate sheet called list. This sheet has dedicated list for names and fruit. I figured excel would be able to tell if information came from these set list.

  5. #5
    p45cal, you're correct I just named the sheet as list. In my real excel it is called inputs.

  6. #6
    The list will not need to be generated as I will be providing that information

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Sub blah()
    Sheets("Names").Cells.ClearContents
    Sheets("Fruit").Cells.ClearContents
    
    DestnColumn = 1
    For Each are In Sheets("Sheet1").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
      'are.Select
      NameDestnRow = 1: FruitDestnRow = 1
      For Each cll In are.Cells
        'cll.Select
        CurrentItem = Application.Trim(cll.Value)
        Set NameFound = Sheets("List").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
        If Not NameFound Is Nothing Then
          Sheets("Names").Cells(NameDestnRow, DestnColumn) = CurrentItem
          NameDestnRow = NameDestnRow + 1
        End If
        Set FruitFound = Sheets("List").Columns(3).Find(what:=cll.Value, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
        If Not FruitFound Is Nothing Then
          Sheets("Fruit").Cells(FruitDestnRow, DestnColumn) = CurrentItem
          FruitDestnRow = FruitDestnRow + 1
        End If
      Next cll
      DestnColumn = DestnColumn + 1
    Next are
    End Sub
    You have a trailing space after the name Bob in Sheet1 (And Hank appears twice, once with a trailing space and once without!). This doesn't matter as I've included Application.Trim in the code, however, it's important that the List sheet entries contain no leading/trailing spaces, otherwise things may not be found.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Another way, this bumps the output over a column each time it finds a blank in the data

    Option Explicit
    Sub MoveData()
        Dim wsList As Worksheet, wsNames As Worksheet, wsFruits As Worksheet, wsData As Worksheet
        Dim rNames As Range, rFruits As Range, rData As Range
        Dim colNames As Long, colFruit As Long ' columns to put the data in
        Dim rowIndex As Long
        Dim rDestination As Range
        
        'init (need Set keyword for objects)
        Set wsList = Worksheets("List")
        Set wsNames = Worksheets("Names")
        Set wsFruits = Worksheets("Fruit")
        Set wsData = Worksheets("Sheet1")
        
        Set rNames = wsList.Columns(1)
        Set rFruits = wsList.Columns(3)
        'A1 to the LAST cell in col A on the sheet up to the first non-blank cell (or A17)
        Set rData = Range(wsData.Cells(1, 1), wsData.Cells(wsData.Rows.Count, 1).End(xlUp))
        
        'clear all old data
        wsNames.Cells(1, 1).CurrentRegion.ClearContents
        wsFruits.Cells(1, 1).CurrentRegion.ClearContents
        
        
        colNames = 1
        colFruit = 1
    
        Application.ScreenUpdating = False
        
        
        'clean the data -- you have trailing blanks in some
        For rowIndex = 1 To rNames.Cells(1, 1).CurrentRegion.Rows.Count
            rNames.Cells(rowIndex, 1).Value = Trim(rNames.Cells(rowIndex, 1).Value)
        Next rowIndex
        For rowIndex = 1 To rFruits.Cells(1, 1).CurrentRegion.Rows.Count
            rFruits.Cells(rowIndex, 1).Value = Trim(rFruits.Cells(rowIndex, 1).Value)
        Next rowIndex
        For rowIndex = 1 To rData.Rows.Count
            rData.Cells(rowIndex, 1).Value = Trim(rData.Cells(rowIndex, 1).Value)
        Next rowIndex
        
        
        
        'go down rData
        With rData      '   anything that starts with a 'dot' 'belongs' to this
            
            For rowIndex = 1 To .Rows.Count
                
                'if blank move over one column
                If Len(.Cells(rowIndex, 1).Value) = 0 Then
                    colNames = colNames + 1
                    colFruit = colFruit + 1
                Else
                    'is it in the Names list?
                    If Not IsError(Application.Match(.Cells(rowIndex, 1).Value, rNames, 0)) Then
                        Set rDestination = wsNames.Cells(wsNames.Rows.Count, colNames).End(xlUp)
                        'if blank this is top row, if not blank then go one down
                        If Len(rDestination.Value) > 0 Then Set rDestination = rDestination.Offset(1, 0)
                        rDestination.Value = .Cells(rowIndex, 1).Value
                        
                    'is it in the Fruit list?
                    ElseIf Not IsError(Application.Match(.Cells(rowIndex, 1).Value, rFruits, 0)) Then
                        Set rDestination = wsFruits.Cells(wsFruits.Rows.Count, colNames).End(xlUp)
                        'if blank this is top row, if not blank then go one down
                        If Len(rDestination.Value) > 0 Then Set rDestination = rDestination.Offset(1, 0)
                        rDestination.Value = .Cells(rowIndex, 1).Value
                    Else
                        MsgBox .Cells(rowIndex, 1).Value & " not a Name or Fruit"
                    End If
                End If
            Next rowIndex
        End With
        Application.ScreenUpdating = True
        MsgBox "All Done"
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    WOW THANK YOU this is exactly what I needed.

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Trace through the code and comments (P45Cal's and mine) to learn and understand

    There are more efficient (probably) ways to do a lot of this, but I opted for straight-forwardness (assuming that's a word). P45cal's is more concise and possibly more efficient

    Use [Thread Tools] above your first post to make it [Solved] if there's nothing more
    Last edited by Paul_Hossler; 06-21-2017 at 07:13 AM. Reason: Hit [Send] too fast
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  11. #11
    recipe formulation 2.0.xlsmThanks, I will make sure to mark it as solved as soon as I figure out how to get it to work in my exact excel spreadsheet. I hate to make people do my work and I want to learn, that is why I just used a example sheet. I'm currently trying to get it to work in my sheet. Once I get it to work I will mark this as solved. Until then you both have been very helpful and I would like to keep it open for a little while I get this worked out. Cheers

    I'm going to post my exact sheet and maybe if you guys find time can take a look at it and it might speed up my questions in the future as I'm trying to add my own sheets to the code you both have wrote.

    In my sheet. Recipes that is what I was using in my example sheet 1. I need column A to move to Either Grain2, Hop2 or Other2. I'm using the list used on the sheet called Inputs for my list.

  12. #12
    I have yet to get this to work using my original spreadsheet. Would either of you be willing to help?

  13. #13
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Sub MoveData()
        Sheets("Grain2").Cells.ClearContents
        Sheets("Hop2").Cells.ClearContents
         
        DestnColumn = 1
        For Each are In Sheets("Recipe").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
             'are.Select
            GrainDestnRow = 1: HopDestnRow = 1
            For Each cll In are.Columns(1).Cells'deals with he merged cells (try not to use merged cells with VBA - they're very hard work!)
                 'cll.Select
                CurrentItem = Application.Trim(cll.Value)
                Set GrainFound = Sheets("Inputs").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
                If Not GrainFound Is Nothing Then
                    Sheets("Grain2").Cells(GrainDestnRow, DestnColumn) = CurrentItem
                    GrainDestnRow = GrainDestnRow + 1
                End If
                Set HopsFound = Sheets("Inputs").Columns(3).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
                If Not HopsFound Is Nothing Then
                    Sheets("Hop2").Cells(HopDestnRow, DestnColumn) = CurrentItem
                    HopDestnRow = HopDestnRow + 1
                End If
            Next cll
            DestnColumn = DestnColumn + 1
        Next are
    End Sub
    Problems:
    Merged columns A and B in Recipe sheet
    Several syntax errors (Recipe instead of Sheets)
    Names of variables not consistent.

    For this last, I should have included some Dim statements at the top of the sub's code as well as a single Option Explicit line at the top of the code module:
    Dim DestnColumn, are, GrainDestnRow, HopDestnRow, cll, CurrentItem, GrainFound, HopsFound
    and this would have shown up spelling differences.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  14. #14
    Thank you. I will try it right after dinner.

  15. #15
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Some of the problems highlighted:

    Sub MoveData()
    Sheets("Grain2").Cells.ClearContents
    Sheets("Hop2").Cells.ClearContents

    DestnColumn = 1
    For Each are In Recipe("Recipe").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
    'are.Select
    Grain2DestnRow = 1: Hop2DestnRow = 1
    For Each cll In are.Cells
    'cll.Select
    CurrentItem = Application.Trim(cll.Value)
    Set GrainFound = Recipe("Inputs").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
    If Not GrainFound Is Nothing Then
    Sheets("Grain2").Cells(GrainDestnRow, DestnColumn) = CurrentItem
    GrainDestnRow = GrainDestnRow + 1
    End If
    Set HopsFound = Recipe("Inputs").Columns(3).Find(what:=cll.Value, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False) 'my mistake:cll.value should be CurrentItem, but it wouldn't have mattered.
    If Not HopsFound Is Nothing Then
    Sheets("Hops2").Cells(HopsDestnRow, DestnColumn) = CurrentItem
    HopsDestnRow = HopsDestnRow + 1
    End If
    Next cll
    DestnColumn = DestnColumn + 1
    Next are
    End Sub

    End Sub


    How many columns will you be searching (curtrently only 2)? If more than 4 then there's probably some shorter code we can use.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  16. #16
    Currently I'm only search 3 columns I go to a fourth but no more than 4

    I tried adding Others to search list and put data into sheet others2.
    Your code worked perfectly for search the 2 columns but when I added a third I did something wrong. I keep getting a error.
    Below is what code I have and I made BOLD and Underlined what the debugger is saying is the issue.
    Another question I have is are my sheet names and my list names to similar that it is making vba work harder?
    I also unmerged cell a and b on the recipe sheet.
    Thanks Again

    Sub MoveData()
    Sheets("Grain2").Cells.ClearContents
    Sheets("Hop2").Cells.ClearContents
    Sheets("Other2").Cells.ClearContents

    DestnColumn = 1
    For Each are In Sheets("Recipe").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
    'are.Select
    GrainDestnRow = 1: HopDestnRow = 1
    For Each cll In are.Columns(1).Cells 'deals with he merged cells (try not to use merged cells with VBA - they're very hard work!)
    'cll.Select
    CurrentItem = Application.Trim(cll.Value)
    Set GrainFound = Sheets("Inputs").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
    If Not GrainFound Is Nothing Then
    Sheets("Grain2").Cells(GrainDestnRow, DestnColumn) = CurrentItem
    GrainDestnRow = GrainDestnRow + 1
    End If
    Set HopsFound = Sheets("Inputs").Columns(3).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
    If Not HopsFound Is Nothing Then
    Sheets("Hop2").Cells(HopDestnRow, DestnColumn) = CurrentItem
    HopDestnRow = HopDestnRow + 1
    End If
    Set OthersFound = Sheets("Inputs").Columns(5).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
    If Not OthersFound Is Nothing Then
    Sheets("Other2").Cells(OthersDestnRow, DestnColumn) = CurrentItem
    OthersDestnRow = OthersDestnRow + 1
    End If
    Next cll
    DestnColumn = DestnColumn + 1
    Next are
    End Sub

  17. #17
    Just saw what you said about errors. Should I rename the sheet named "Recipe" back to Sheet?
    Change sheet names that are too close to list named on input sheet?

  18. #18
    After Some playing around I got it to work. Thanks Again!!!!!!

  19. #19
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Sheet names and variable names are fine as they are.
    Change:
    GrainDestnRow = 1: HopDestnRow = 1
    To:
    GrainDestnRow = 1: HopDestnRow = 1: OthersDestnRow = 1
    (Not near a computer at the moment)
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

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