View Single Post
 
Old 12-14-2014, 01:33 AM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Ok here is a code to get you started. This looks at the data on the first worksheet in column A. It will put a result into column B. The strings for it to search get entered on the 2nd worksheet. ex: col A = donalds, col B= food.
The code assumes that you have headers for both worksheets and will start on row 2. You can add as many search strings that you want on the 2nd worksheet.

Code:
Option Explicit

Sub IdentifyCharge()
  'Looks through column A and an array then identifies the type of charge.
  Dim CheckRow As Long, LastRow As Long, CheckString As String
  Dim ArrayString As String, TypeArray As Variant, x As Integer
  Dim ResultString As String, ResultArray As Variant, ResultValue As String
  Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
  
  'Set the references
  Set wb = ThisWorkbook
  Set ws1 = wb.Worksheets(1)
  Set ws2 = wb.Worksheets(2)
  LastRow = ws1.Range("A50000").End(xlUp).Row
  
  'Fill in the string with arrays to check
  For CheckRow = 2 To 50000
    If ws2.Range("A" & CheckRow).Value = "" Then Exit For
    ArrayString = ArrayString & ws2.Range("A" & CheckRow).Value & "|"
    ResultString = ResultString & ws2.Range("B" & CheckRow).Value & "|"
  Next CheckRow
  
  'Remove trailing delimiters
  ArrayString = Mid(ArrayString, 1, Len(ArrayString) - 1)
  ResultString = Mid(ResultString, 1, Len(ResultString) - 1)
  
  'Convert strings to arrays
  TypeArray = Split(ArrayString, "|")
  ResultArray = Split(ResultString, "|")
  
  'Run through the list in worksheet 1 and give the results
  For CheckRow = 2 To LastRow
    ResultString = ""
    CheckString = LCase(ws1.Range("A" & CheckRow).Value)
    For x = 0 To UBound(TypeArray)
      If InStr(1, CheckString, LCase(TypeArray(x))) Then
        ResultString = ResultArray(x)
        Exit For
      End If
    Next x
    ResultValue = Mid(CheckString, InStr(1, CheckString, "-"))
    ResultString = ResultValue & " " & ResultString
    ws1.Range("B" & CheckRow).Value = ResultString
  Next CheckRow
  
End Sub
As with all code be sure to save your workbook before running since macro procedures cannot be "undone" once ran.

Let me know how it all works out for you.

Thanks
Reply With Quote