Results 1 to 6 of 6
  1. #1
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Illinois
    Posts
    552
    Thanks
    0
    Thanked 1 Time in 1 Post

    Ugly code needs help (Excel xp)

    I have some code which i don't know how to make more efficient...

    I'm looking down a column of data. The reason i replace the > and # signs to numbers (777777 or 888888) is because that's the only way i could think of to make it work. The macro basically looks for letters in the column and moves them up and one col to the right so they are next to the numerals or the > or # sign. It works the way it is but i can't figure out how to make it cycle through the columns without copying the code over and over again.

    Also, i use the macro on different files and there are a different amount of columns in each different file. I've included all the possible columns that need to be changed but the macro will go faster if it changes to allow for the number of columns that the specific files has instead cycling through all the columns.


    Sub MoveLetter()
    Dim rng As Range

    Range("B:B, E:E, H:H, K:K, N:N, Q:Q, T:T, W:W, Z:Z, AC:AC, AF:AF, AI:AI, AL:AL, AO:AO, AR:AR, AU:AU, AX:AX, BA:BA, BD:BD, BG:BG, BJ:BJ, BM:BM, BP:BP, BS:BS, BV:BV, BY:BY, CB:CB, CE:CE, CH:CH").EntireColumn.Select
    Selection.Cells.Replace What:="#", _
    Replacement:=7777777, LookAt:=xlPart, MatchCase:=False
    Selection.Cells.Replace What:=">", _
    Replacement:=8888888, LookAt:=xlPart, MatchCase:=False

    Range("B:B").Select
    For Each cell In Selection.SpecialCells(xlConstants, xlNumbers)
    cell.Offset(1, 0).Range("A1").Select ' Down one cell...
    If Not (IsNumeric(ActiveCell.Text)) Then ' if the cell is not data...
    sCellBelowContents = ActiveCell.Text ' copy the source.
    ActiveCell.Value = "" ' delete the source.
    cell.Offset(0, 1).Range("A1").Select ' One to the right...
    ActiveCell.Value = sCellBelowContents ' paste data into destination cell.
    End If
    Next cell
    Range("H:H").Select
    For Each cell In Selection.SpecialCells(xlConstants, xlNumbers)
    cell.Offset(1, 0).Range("A1").Select ' Down one cell...
    If Not (IsNumeric(ActiveCell.Text)) Then ' if the cell is not data...
    sCellBelowContents = ActiveCell.Text ' copy the source.
    ActiveCell.Value = "" ' delete the source.
    cell.Offset(0, 1).Range("A1").Select ' One to the right...
    ActiveCell.Value = sCellBelowContents ' paste data into destination cell.
    End If
    Next cell
    Range("B:B").Select
    For Each cell In Selection.SpecialCells(xlConstants, xlNumbers)
    cell.Offset(1, 0).Range("A1").Select ' Down one cell...
    If Not (IsNumeric(ActiveCell.Text)) Then ' if the cell is not data...
    sCellBelowContents = ActiveCell.Text ' copy the source.
    ActiveCell.Value = "" ' delete the source.
    cell.Offset(0, 1).Range("A1").Select ' One to the right...
    ActiveCell.Value = sCellBelowContents ' paste data into destination cell.
    End If
    Next cell

    ActiveSheet.Cells.Replace What:=7777777, _
    Replacement:="#", LookAt:=xlPart, MatchCase:=False
    ActiveSheet.Cells.Replace What:=8888888, _
    Replacement:=">", LookAt:=xlPart, MatchCase:=False
    End Sub


    Thank you for helping me again. <img src=/S/compute.gif border=0 alt=compute width=40 height=20>

  2. #2
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Ugly code needs help (Excel xp)

    Examine all the columns in the sheet, set an outside loop that checks that the modulus of the column number is equal to zero plus two (hope that logic is correct) , something like (untested air code, it's late):

    [Edited, I missed an "End If"]

    Dim rngColumn as Range, rngActiveCol as Range, rngCell as Range
    For Each rngColumn in Worksheets(Activesheet.Name).Columns 'hope this is valid ;->
    If rngColumn.Column = 2 OR (rngColumn.Column -2 Mod 3) = 0 Then
    On Error Resume Next ' for empty columns
    Set rngActiveCol = rngColumn.SpecialCells(xlConstants, xlTextValues)
    If rngActiveCol Is Not Nothing Then ' it has content so process it
    For each rngCell in rngActiveCol
    If InStr(rngCell, "#") Then ' run process for #
    If InStr(rngCell, ">") Then ' run process for >
    Next rngCell
    End If
    End If
    Next rngColumn
    -John ... I float in liquid gardens
    UTC -7ąDS

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Ugly code needs help (Excel xp)

    Isn't this essentially the same problem that you asked about in <post#=236013>post 236013</post#>?

    Steve

  4. #4
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Ugly code needs help (Excel xp)

    Also, if I follow, this code

    cell.Offset(1, 0).Range("A1").Select ' Down one cell...
    If Not (IsNumeric(ActiveCell.Text)) Then ' if the cell is not data...
    sCellBelowContents = ActiveCell.Text ' copy the source.
    ActiveCell.Value = "" ' delete the source.
    cell.Offset(0, 1).Range("A1").Select ' One to the right...
    ActiveCell.Value = sCellBelowContents ' paste data into destination cell.
    End If

    can be simplified to this, and should run faster because of the elimination of the select command, plus it won't leave vbNullStrings ("") scattered about

    If Not (IsNumeric(cell.Offset(1, 0).Value)) Then ' if the cell offset 1 down is not data
    cell.Offset(0, 1).Value = cell.Offset(1, 0).Value ' copy cell offset 1 down value to cell offset 1 right
    cell.Offset(1, 0).ClearContents ' clear cell offset 1 down
    End If

    But I don't understand what you are doing with the Find-&-Replace for "#" & ">" ...
    -John ... I float in liquid gardens
    UTC -7ąDS

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Ugly code needs help (Excel xp)

    I think part of his problem is that he wants VB to think that "#" and ">" are numbers when they are NOT.

    So he does a find/replace to change the #s to 7777777s and the >s to 8888888s (before he runs the code). So NOW they are numbers. Then he switches them back in the code.

    Steve

  6. #6
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Ugly code needs help (Excel xp)

    Without knowing the data layout I'd probably use something like

    If Not CBool(InStr(rngCell.Value, "#") + InStr(rngCell.Value, ">")) Then ' process

    rather that a Find-&-Replace
    -John ... I float in liquid gardens
    UTC -7ąDS

Posting Permissions

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