Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Excel > Excel Programming

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 02-02-2012, 05:05 AM
SaneMan SaneMan is offline Windows 98/ME Office 2003
Novice
 
Join Date: Jan 2011
Posts: 20
SaneMan is on a distinguished road
Default Change values in cells based on criteria

Hello



I'm currently dealing with a number of Excel databases containing rows of data with the main identifier being the reference number in the first column. For some annoying reason these references are modern variations of historic reference numbers we have and for this project I need the historic numbers which we do not have readily available so I'm trying to convert them intelligently.

We have a set manual criteria for converting these modern references. The modern references are always formatted in the same way - four letters, a full stop and then four numbers. All I need to convert are the letters at the beginning based on a set criteria.

I'm trying to come up with a way of converting these automatically, probably with a Macro, but I'm struggling to figure out how to write it. I need the macro to loop through all the modern reference numbers in the column and replace the four letters with the set criteria, for example 'CTCP' (modern ref) would convert to 'P '.

I've probably not explained it too well, but I hope someone can help. I've attached a mock up of one of the spreadsheets if it helps.

Thanks.
Attached Files
File Type: xls Example conversion.xls (16.5 KB, 3 views)
Reply With Quote
  #2  
Old 02-02-2012, 07:48 AM
JBeaucaire JBeaucaire is offline Windows XP Office 2003
Advanced Beginner
 
Join Date: Dec 2011
Posts: 51
JBeaucaire is on a distinguished road
Default

This should do it for you, add more "cases" if you wish:

Code:
Option Explicit

Sub AdjustHistoricCodes()
Dim MyCodes As Variant, c As Long, LR As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

MyCodes = Application.Transpose(Range("A2:A" & LR))

For c = LBound(MyCodes) To UBound(MyCodes)
    Select Case UCase(Left(MyCodes(c), 4))
        Case "CTCR":    MyCodes(c) = "N" & Mid(MyCodes(c), 5, Len(MyCodes(c)))
        Case "CTCP":    MyCodes(c) = "P" & Mid(MyCodes(c), 5, Len(MyCodes(c)))
        Case "CTWC":    MyCodes(c) = "CP" & Mid(MyCodes(c), 5, Len(MyCodes(c)))
        Case "CASM":    MyCodes(c) = "S / WR" & Mid(MyCodes(c), 5, Len(MyCodes(c)))
        Case "CANM":    MyCodes(c) = "N / WR" & Mid(MyCodes(c), 5, Len(MyCodes(c)))
    End Select
Next c

Range("A2:A" & LR).Value = Application.Transpose(MyCodes)
    
End Sub
Reply With Quote
  #3  
Old 02-02-2012, 07:58 AM
SaneMan SaneMan is offline Windows 98/ME Office 2003
Novice
 
Join Date: Jan 2011
Posts: 20
SaneMan is on a distinguished road
Default

Many thanks, JBeaucaire! Just tested it and it works perfectly! Thanks again.
Reply With Quote
Reply
Please reply to this thread with any new information or opinions.

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Automatically change the value of one cell so that two other cells become equal matthew544 Excel 5 09-18-2011 08:56 AM
Selecting blank cells in criteria apolloman Excel 6 08-24-2011 05:38 AM
How can I change the colors of cells automatically based on Job Completion? Learner7 Excel 0 07-06-2010 10:47 PM
Count range cells eliminating merge cells danbenedek Excel 0 06-15-2010 12:40 AM
How to count cells containing data and meet certain criteria AdamNT Excel 1 08-11-2006 11:51 PM


All times are GMT -7. The time now is 03:02 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft