1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Excel macro : cell with multiple content

Discussion in 'Business Applications' started by Ataraxiste, Jul 22, 2004.

Thread Status:
Not open for further replies.
Advertisement
  1. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    Hi,

    I have a large excel worksheet, divided into 4 rows (different data fields). Hard luck, in one of the rows, some cells contain two products or more instead of one (ex: "ZB3054066¦¦ZB3601207¦¦ZB3601206"). They are separated either by a blank or by a ¦¦ (double bar).
    I need that each time I detect a cell in that particular row that contains multiple products, I create new rows so that each row contains only one product in the column "component parts" and that the original data in the other columns remains unchanged.
    I don't know anything about excel macro, but here is the approximate code I created to do this task :
    If current row cell "component parts" contains a separator (either or blank),
    {
    create "number of separators" new rows
    copy every field except the "component parts" one
    while( cell "component parts" contains a separator)
    {
    cut the part of the "component parts" cell before the first separator (including the separator)
    paste it into the next row "component part" cell
    delete the separator in the new "component parts" cell
    }
    }

    If anyone knows how I could do this in an excel macro...
    Thanks.
     
  2. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    Can you post the workbook or post some sample data so I can see exactly what each column and row looks like.



    Rollin
     
  3. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    Here is a sample data from the worksheet (the worksheet is too big, 7000 rows). Simply rename the txt extension into a xls extension (the filter in this site does not allow xls extensions).
    Thanks

    By the way, I had seen a wrong symbol : the separator is not a double ¦¦, but in fact it is a new line symbol (black square). It comes from an export from a lotus database, I have checked it again but I always get this symbol, which is pretty annoying as I can't manage to type it in any excel tool (even when I copy and paste it to here, it is interpretated as a new line...)
     

    Attached Files:

  4. Kelly_in_LA

    Kelly_in_LA

    Joined:
    Jun 16, 2004
    Messages:
    47
    Ataraxiste,

    Thank you SO much for posting your sample file. Your sample file is crucial to getting a good solution.

    So far, I have created the following macro, which I have tested on your sample. I would encourage you to try this macro, but AS ALWAYS, you should test it on a "safe" copy of your file, so if anything gets messed up, you haven't damaged the "real" file.

    Here is the macro, but please read my notes at the bottom about certain "issues" that may need to be changed for you...

    Code:
    Sub NewRows_For_ComponentParts()
    
    Dim UserChoice As Byte 'will contain OK or Cancel depending on user response
    Dim MyArray() As String 'will receive the individual part numbers from cells that have many part nos
    Dim myRow
    Dim myCol
    Dim x
    
    UserChoice = MsgBox(ActiveSheet.Name & vbCr & vbCr & "Make sure that  """ & _
                 ActiveSheet.Name & """  is the sheet you wish to apply this macro to." & _
                 vbCr & vbCr & "To proceed with the application of this macro on  """ _
                 & ActiveSheet.Name & ",""  click OK.  Otherwise, click Cancel.", _
                 vbOKCancel, ActiveSheet.Name)
    
    If UserChoice = 2 Then End
    
    Dim myCell As Range
    
    For Each myCell In ActiveSheet.UsedRange
    
        If InStr(1, Trim(CStr(myCell.Cells.Value)), Chr(13) & Chr(10), vbBinaryCompare) > 0 Then
            
            MyArray = Split(Trim(CStr(myCell.Cells.Value)), Chr(13) & Chr(10))
            
            myRow = CInt(myCell.Row)
            myRow = myRow + 1
            myCol = myCell.Column
                
                For x = 0 To (UBound(MyArray) - 1)
                    Rows(CStr(myRow + x) & ":" & CStr(myRow + x)).Insert Shift:=xlDown
                    Cells(myRow + x, myCol).Value = MyArray(x + 1)
                Next
            
            Cells(myRow - 1, myCol).Value = MyArray(0)
            
        End If
    
    Next
    
    End Sub
    Here are the "issues" I alluded to above...

    this macro only affects cells that have the "two boxes" (the newline character).

    So, if there are many cells where the part numbers are separated by a space rather than a newline, then the macro will need to be changed.

    I did not change it yet, for the following reason:

    I have chosen to make this macro look at ALL OF THE CELLS IN ALL COLUMNS. So, this could be another problem and other option that should be changed. Because I'm looking in all cells, it is not a good idea to divide any cells with spaces in them, because column B contains cells that say "standard input module," which would then be divided into three new rows.

    Ataraxiste, you are the only one who can specify which changes I should make.

    Should the macro only look at column C?

    Let me know what you think.

    Thanks!
    -Kelly
    ____________________
    View my Word macros
     
  5. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    Thank you for your efforts. In fact, I only need to have the column C checked. In that case, the blank separator can also be used.
    I will try your solution on a sample file to see if it's the good way.
    It was such a pain in the neck to cope with the new line symbol...
    Thank you again.
     
  6. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    I have forgotten to say that I'm running on Excel 97, and I think that the split function you used has been implemented only in Excel2000. Could you do anything about this too ?
    By the way, thanks to the ideas contained in your code, I managed to replace every new line character with a space instead, by using the following macro :
    Sub changeStr()

    EndCell = Range("A1").SpecialCells(xlCellTypeLastCell).Address

    ActiveSheet.Range("A1:" & EndCell).Replace _
    What:=Chr(13) & Chr(10), Replacement:=Chr(32), _
    SearchOrder:=xlByColumns, MatchCase:=True

    End Sub

    This way we only have to focus on the spaces separators, which may allow us to use predefined functions.
    The problem is now : examine and trim each cell in the C column. Create as many new rows as the cell contains of blanks, and copy each cell of the new rows except those on the C column ; fill the C column with the different datas that were separated by the blanks in the first C cell.
     
  7. Kelly_in_LA

    Kelly_in_LA

    Joined:
    Jun 16, 2004
    Messages:
    47
    Okay, here goes VERSION TWO...

    Code:
    Sub NewRows_For_ComponentParts()
    
    Dim UserChoice As Byte 'will contain OK or Cancel depending on user response
    Dim HowManyRows As Long 'this is for a loop. this number is CUSTOMIZABLE !!! Please adjust according to need
    Dim myContents As String 'will hold the contents of any cell found with multiple part numbers
    Dim Position As Byte 'the position in the string where a SPACE character is found
    
    UserChoice = MsgBox(ActiveSheet.Name & vbCr & vbCr & "Make sure that  """ & _
                 ActiveSheet.Name & """  is the sheet you wish to apply this macro to." & _
                 vbCr & vbCr & "To proceed with the application of this macro on  """ _
                 & ActiveSheet.Name & ",""  click OK.  Otherwise, click Cancel.", _
                 vbOKCancel, ActiveSheet.Name)
    
    If UserChoice = 2 Then End
    
    Dim ThirdColumn As Range
    Set ThirdColumn = ActiveSheet.Columns(3)
    
    For HowManyRows = 2 To 10000
    
    myContents = Trim(ThirdColumn.Cells(HowManyRows).Value)
    
    Position = InStr(1, myContents, " ", vbBinaryCompare)
        If Position > 0 Then
             
            ThirdColumn.Cells(HowManyRows).Value = Trim(Left(myContents, Position))
            myContents = Right(myContents, (Len(myContents) - Position))
            
            Rows(CStr(HowManyRows + 1) & ":" & CStr(HowManyRows + 1)).Insert Shift:=xlDown
            Cells(HowManyRows + 1, 3).Value = myContents
            
        End If
    
    Next
    
    End Sub

    The macro has now been adapted to look ONLY in column C, to search ONLY for space characters, and to AVOID all use of the "Split" function.

    The funny thing is... I always considered "Split" to be such a great feature, and now that I was forced to rewrite a macro to get Split out of the question, I actually like the non-split macro better than the one that used Split!!!

    how funny is that. Perhaps "split" is overrated :)

    Oh, one more note:
    The loop currently starts at C2 (because I think C1 is a heading, correct?) and goes all the way to C10000. This could be changed in any which way imaginable. It could start at C23 and go to C459. Anything at all. We would just change the line that says:

    For HowManyRows = 2 To 10000

    So... I think we have done it!

    Let me know if it works, Ataraxiste. It was really fun to collaborate with you!

    -Kelly
    _____________________
    A Link to Kelly's Silliness
     
  8. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    I've too have coded a macro that will do what you want it to do :D . Let me know if the one posted by Kelly doesn't work right for you. BTW....how to you handle the scenario where column C contains a component part and a note such as:

    ZJ0255006 One Complete relay

    Are there other Random notes like this in Column C ?



    Rollin
     
  9. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    One more thing......the macro I wrote for you will also adjust Column D automatically for you so that the Order Quantity will be fixed as well. Lemme know if you want it



    Rollin
     
  10. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    Kelly,

    I tried to run your macro on Ataraxiste's sample data and it did not appear to work. I copied the code straight from your post. Are you sure you posted the right code and/or tested it :confused:



    Rollin
     
  11. Kelly_in_LA

    Kelly_in_LA

    Joined:
    Jun 16, 2004
    Messages:
    47
    Hi Rollin!

    I have tested "version two by Kelly" (by me!) and I do believe that it works correctly.

    Here is (most likely) why it did not work for you:

    you CANNOT test it with the sample file that was posted by Ataraxiste.

    You see, she posted that sample to illustrate her original problem of the NEWLINE characters.

    She has since stated that she replaced all the newlines with a single-space. A simple spacebar press, or whatever else we could call the character.

    So my "version two" will NOT work on the "sample.txt" file.

    (y) Rollin, I am SO glad you posted your comment, because hopefully now that I have seen your confusion (which I caused) and I have hopefully clarified the situation, then together you and I have saved many future viewers of this thread from heartache. Thanks so much, Rollin! :)

    For better clarity, I will post "kellysample.txt" below. Like the original "sample.txt" everyone needs to change the name to "kellysample.xls" after downloading and before opening.

    Thanks!
    -Kelly
     

    Attached Files:

  12. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    Concerning the random notes, they are neglectable, as I only need to see which component is the most used. We can just ignore them.
    And if you could post your solution, I'm sure it would help.
    Thanks to you all for your help !
     
  13. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    Kelly_in_LA,

    Your code seems to work to a certain extent, except that it fails to copy the values of the other cells of the row (it only creates the new rows (fine), pastes the different contents of the cell in column c (fine), but leaves the other columns of the new rows empty (not fine) ).
    I also think that the code may be improved if you inserted somewhere after the paste of the c column a trim function (the separators remain in the cells after).
    Thanks for your help.
     
  14. Ataraxiste

    Ataraxiste Thread Starter

    Joined:
    Jul 22, 2004
    Messages:
    22
    I finally managed with a few edits to complete the task. I enclose here the two macros I used (one of mine and the other is Kelly's edited).
    Thanks to everybody, you have been of great help !

    Macro 1 (replaces new line and carriage return symbols with a blank) :
    Sub changeStr()

    EndCell = Range("A1").SpecialCells(xlCellTypeLastCell).Address

    ActiveSheet.Range("A1:" & EndCell).Replace _
    What:=Chr(13) & Chr(10), Replacement:=Chr(10), _
    SearchOrder:=xlByColumns, MatchCase:=True

    End Sub


    Macro 2 (everytime it detects a cell with multiple content, it creates enough new rows and fills them with the values wanted)

    Sub NewRows_For_ComponentParts()

    Dim UserChoice As Byte 'will contain OK or Cancel depending on user response
    Dim HowManyRows As Long 'this is for a loop. this number is CUSTOMIZABLE !!! Please adjust according to need
    Dim myContents As String 'will hold the contents of any cell found with multiple part numbers
    Dim Position As Byte 'the position in the string where a SPACE character is found

    UserChoice = MsgBox(ActiveSheet.Name & vbCr & vbCr & "Make sure that """ & _
    ActiveSheet.Name & """ is the sheet you wish to apply this macro to." & _
    vbCr & vbCr & "To proceed with the application of this macro on """ _
    & ActiveSheet.Name & ","" click OK. Otherwise, click Cancel.", _
    vbOKCancel, ActiveSheet.Name)

    If UserChoice = 2 Then End

    Dim ThirdColumn As Range
    Set ThirdColumn = ActiveSheet.Columns(3)

    For HowManyRows = 2 To 10000

    myContents = Trim(ThirdColumn.Cells(HowManyRows).Value)

    Position = InStr(1, myContents, " ", vbBinaryCompare)
    If Position > 0 Then

    ThirdColumn.Cells(HowManyRows).Value = Trim(Left(myContents, Position))
    myContents = Right(myContents, (Len(myContents) - Position))

    Rows(CStr(HowManyRows + 1) & ":" & CStr(HowManyRows + 1)).Insert Shift:=xlDown
    Cells(HowManyRows + 1, 3).Value = Trim(myContents)
    Cells(HowManyRows + 1, 1).Value = Cells(HowManyRows, 1).Value
    Cells(HowManyRows + 1, 2).Value = Cells(HowManyRows, 2).Value
    Cells(HowManyRows + 1, 4).Value = Cells(HowManyRows, 4).Value

    End If

    Next

    End Sub


    Problem solved !
     
  15. Kelly_in_LA

    Kelly_in_LA

    Joined:
    Jun 16, 2004
    Messages:
    47
    Hi again, Ataraxiste!

    I'm so glad that your problem was solved.

    It was definitely a group effort. It's so nice to collaborate with someone who can edit my code and send back newer, better versions of it. I really appreciate that you posted your final solution back into the thread. I always like to hear the "happy ending" to these threads.

    Regarding the following:
    *****************

    *****************

    I never had a clear idea of what you needed to do with the other columns, so I left that up to you. My sole intention from the beginning was to deal with column C. I had a feeling that you were a savvy "asker" -- savvy enough to take my suggestions and tweak them -- and I was right !

    I look forward to seeing you again back in the forum!

    Best wishes,
    Kelly
     
  16. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/253159

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice