+ Reply to Thread
Results 1 to 5 of 5

Changing Digits

  1. #1
    Registered User
    Join Date
    09-19-2006
    Posts
    6

    Changing Digits

    Below is the code I used:

    Sub Cleanliness_Negative_Weighting()

    On Error Resume Next

    ' The following converts 1's to 5s; 2's to 4s; 3's to 3s; 4's to 2s; and 5's to 1s in the specified columns

    With [l:l,p:p,r:r,s:s,w:w,y:y]
    .Replace what:="1", replacement:=5, lookat:=xlWhole
    .Replace what:="2", replacement:=4, lookat:=xlWhole
    .Replace what:="4", replacement:=2, lookat:=xlWhole
    .Replace what:="5", replacement:=1, lookat:=xlWhole
    End With

    End Sub

    Essentially I have data that needs to be negatively weighted ie 1s changed to 5s and 2s changed to 4s ect....

    The problem I have is the second two ".Replace..."s negate the first two. How do I get the macro to ignore cells its already changed? Any help would be grealty appreciated

  2. #2
    Forum Contributor
    Join Date
    07-13-2006
    Posts
    400
    Quote Originally Posted by BAC240SX
    Below is the code I used:

    Sub Cleanliness_Negative_Weighting()

    On Error Resume Next

    ' The following converts 1's to 5s; 2's to 4s; 3's to 3s; 4's to 2s; and 5's to 1s in the specified columns

    With [l:l,p:p,r:r,s:s,w:w,y:y]
    .Replace what:="1", replacement:=5, lookat:=xlWhole
    .Replace what:="2", replacement:=4, lookat:=xlWhole
    .Replace what:="4", replacement:=2, lookat:=xlWhole
    .Replace what:="5", replacement:=1, lookat:=xlWhole
    End With

    End Sub

    Essentially I have data that needs to be negatively weighted ie 1s changed to 5s and 2s changed to 4s ect....

    The problem I have is the second two ".Replace..."s negate the first two. How do I get the macro to ignore cells its already changed? Any help would be grealty appreciated
    use a for loop

    if your numbers will have multiple occurences
    i.e. 55432 needs to become 11234 then increment through each character in each cell with a for i=1 to j, where j=len(cell)
    if they don't have multiple occurences then just loop through using a for i=1 to j, where j=last row

  3. #3
    Registered User
    Join Date
    09-19-2006
    Posts
    6
    I'm sorry I'm not sure how exactly to use a for loop.

    I should have specified that I didn't write the code I used myself, another on this forum helped me a while ago and I just modified what he wrote for use in this situation.

    The numbers definately do not have multiple occurences, they single digits in individual cells.

  4. #4
    Forum Contributor
    Join Date
    07-13-2006
    Posts
    400
    Quote Originally Posted by BAC240SX
    I'm sorry I'm not sure how exactly to use a for loop.

    I should have specified that I didn't write the code I used myself, another on this forum helped me a while ago and I just modified what he wrote for use in this situation.

    The numbers definately do not have multiple occurences, they single digits in individual cells.
    I'll give it a try, but no promises
    can you give me a couple lines of data to see what it looks like as well as what you would like it converted to so I'm sure I understand fully.

  5. #5
    Forum Contributor
    Join Date
    07-13-2006
    Posts
    400
    Quote Originally Posted by BAC240SX
    I'm sorry I'm not sure how exactly to use a for loop.

    I should have specified that I didn't write the code I used myself, another on this forum helped me a while ago and I just modified what he wrote for use in this situation.

    The numbers definately do not have multiple occurences, they single digits in individual cells.
    hope your data is all numbers as this seemed to convert letters to numerical equivalents. I apologize for the lack of cleanliness, and I'm sure it's not the most efficient method but i think it'll work for your purposes:

    Sub Cleanliness_Negative_Weighting()

    On Error Resume Next

    Dim TextValue As String
    Dim NewText As String
    Dim NewBeg As String
    Dim NewEnd As String
    Dim Char As String
    Dim NewChar As String
    Dim i As Long
    Dim j As Long
    Dim Length As Long
    Dim rows As Long
    Dim cols As Long


    cols = 1 'change from 1 to whichever is the relevant column
    rows = 100 'change from 100 to however many rows are relevant


    For i = 1 To rows
    TextValue = Cells(i, cols).Value
    Length = Len(TextValue)
    For j = 1 To Length
    NewBeg = Left(TextValue, j - 1)
    NewEnd = Right(TextValue, Len(TextValue) - j)
    Char = Mid(TextValue, j, 1)
    Select Case Char
    Case "1"
    NewChar = 5
    Case "2"
    NewChar = 4
    Case "3"
    NewChar = 3
    Case "4"
    NewChar = 2
    Case "5"
    NewChar = 1
    End Select
    TextValue = NewBeg & NewChar & NewEnd
    Next j
    Cells(i, cols).Value = TextValue
    Next i
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1