VBA for Text to Column and Vlookup and Concatenate

[Akshay_divecha]

Dear Experts,

Not able to add an attachment.

Working on a code that can fetch file name from local drive and rename it.

Have break inrto 3 codes.

1. Fetching file name
2. Getting the new file name
3. Renaming in local drive.

Macro 1 & 3 are working fine but facing issues with macro 2.

I need to do below things,
1. copy data from column A to column B (not first row but from 2 row till the last row)
2. on column B - Text to column, delimited, other, -
3. on column C - vlookup the value in worksheet FDR150 column "AF :AJ" and fetch the value of "AJ"
4. on column D - vlookup the value in "C" in worksheet location codes column " B:C" and fetch the value on "C"
5. on column E - Concatenate "column D" "space" "column A"

Here is the code but it is limited to 200 rows i am looking to get the details till the last updated row.

Please help.

Sub GetFileName()
'
' GetFileName Macro
'

'
    range("A2").Select
    range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    range("B2").Activate
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    ActiveWindow.SmallScroll Down:=-3
    range("C2").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'FDR150'!C[29]:C[33],5,0)"
    range("D2").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'Nhava Sheva Location Codes'!C[-2]:C[-1],2,0)"
    range("E2").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"" "",RC[-4])"
    range("C2:E2").Select
    Selection.Copy
    range("B2").Select
    Selection.End(xlDown).Select
    range("C382").Select
    range(Selection, Selection.End(xlUp)).Select
    range("C3:C382").Select
    range("C382").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.ScrollRow = 361
    ActiveWindow.ScrollRow = 358
    ActiveWindow.ScrollRow = 278
    ActiveWindow.ScrollRow = 199
    ActiveWindow.ScrollRow = 141
    ActiveWindow.ScrollRow = 90
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 33
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 1
    range("E2").Select
End Sub

 

[Fluff]

But col E on Rename is your new file name.

 

[Akshay_divecha]

Yes... that needs to be shifted on column F

 

[Fluff]

How about

Sub GetFileName()
    
   Dim usdrws As Long
   
   usdrws = Range("A" & Rows.Count).End(xlUp).Row
   
   Range("B2:B" & usdrws).FormulaR1C1 = "=LEFT(rc[-1],FIND(""-"",rc[-1])-1)+0"
   Range("C2:C" & usdrws).FormulaR1C1 = "=VLOOKUP(RC[-1],'FDR150'!C[29]:C[33],5,0)"
   Range("D2:D" & usdrws).FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'Location Codes'!C[-2]:C[-1],2,0)"
   Range("E2:E" & usdrws).FormulaR1C1 = "=VLOOKUP(RC[-3],'FDR150'!C32:C37,6,0)"
   Range("F2:F" & usdrws).FormulaR1C1 = "=IF(OR(ISNUMBER(FIND(""LORDS"",rc[-1])),ISNUMBER(FIND(""FREIGHT"",rc[-1])),ISNUMBER(FIND(""NEWPORT"",rc[-1]))),""F"","""")"
   Range("G2:G" & usdrws).FormulaR1C1 = "=if(rc[-1]="""",CONCATENATE(RC[-3],"" "",RC[-6]),concatenate(rc[-1],"" "",RC[-3],"" "",RC[-6]))"
End Sub

I've used an extra column so the file name is now in G

 

[Akshay_divecha]

Thanks... would like to know if there is any option to put variables in one string like below

"LORDS","FREIGHT","NEWPORT"

As there will be many as such variables...

 

[Akshay_divecha]

Dear Fluff,

Would need your help if can mention LORDS, FREIGHT, NEWPORT in one string as there will be many more as such.

 

[Fluff]

Do you need to keep the formulae, or are you happy with hard values?

 

[Akshay_divecha]

Do you need to keep the formulae, or are you happy with hard values?

Hi.. m not well versed with the language.. can you pls simplify your question?

i dont mind to write such variables in any column of worksheet "Location Codes"

 

[Fluff]

Try this

Sub GetFileName2()
    
   Dim usdrws As Long
   Dim Cl As Range
   Dim Fnd As Range
   Dim Ws As Worksheet
   Dim Ary As Variant
   Dim i As Long
   
   Set Ws = Sheets("FDR150")
   usdrws = Range("A" & Rows.Count).End(xlUp).Row
   Ary = Array("LORDS", "FREIGHT", "NEWPORT")
   
   Range("B2:B" & usdrws).FormulaR1C1 = "=LEFT(rc[-1],FIND(""-"",rc[-1])-1)+0"
   For Each Cl In Range("B2:B" & usdrws)
      Set Fnd = Ws.Range("AF:AF").Find(Cl.Value, , , xlWhole, , , , , False)
      If Not Fnd Is Nothing Then
         Cl.Offset(, 1).Value = Fnd.Offset(, 2).Value
         Cl.Offset(, 3).Value = Fnd.Offset(, 5).Value
         For i = LBound(Ary) To UBound(Ary)
            If InStr(1, Cl.Offset(, 3).Value, Ary(i), vbTextCompare) > 0 Then
               Cl.Offset(, 4).Value = "F"
               Exit For
            End If
         Next i
      End If
   Next Cl
   Range("D2:D" & usdrws).FormulaR1C1 = "=VLOOKUP(RC[-1],'Location Codes'!C[-2]:C[-1],2,0)"
   Range("G2:G" & usdrws).FormulaR1C1 = "=if(rc[-1]="""",CONCATENATE(RC[-3],"" "",RC[-6]),concatenate(rc[-1],"" "",RC[-3],"" "",RC[-6]))"
End Sub

 

[Akshay_divecha]

Thanks for your help..

just needs one correction as below..

in worksheet Rename.. column C... data to be fetch from worksheet FDR150... column AJ

your above code is fetching the data from column AH from worksheet FDR150

 

[Fluff]

Make this change

      If Not Fnd Is Nothing Then
         Cl.Offset(, 1).Value = Fnd.Offset(, [COLOR=#ff0000]4[/COLOR]).Value
         Cl.Offset(, 3).Value = Fnd.Offset(, 5).Value