-1

I want to save my workbook with a filename depending on data in one of the cells. This isn't too difficult, but I want to use a three character code instead of the full cell contents in the original.

So if cell F2 contains "United States" then Dim = "USA"
Else if it contains "Great Britain" then "GBR"
Else if it contains "India" then "IND"
Else "JAP"

Then at the bottom:

Save as `Filename:="C:\My documents\"` & Dim from above & "File" & 

    Format(date, "yyyymmdd") & ". xlsx"

So the file name depends on a shortened version of the F2 cell's contents.


Sub BACS()
'
' BACS Macro
'

'
    Windows("Book1").Activate
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Columns("I:I").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "000000"
    Sheets("Sheet1").Select
    Columns("H:H").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("B:B").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "00000000"
    Sheets("Sheet1").Select
    Columns("L:L").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("E:E").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "#,##0.00"
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="&", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Sheets("Sheet2").Select
    Sheets("Sheet2").Move
    ChDir "C:\Users\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Desktop\” & 
IF Sheet1.Range(“F2”).Value = “United States” Then
Debug.Print “USA”
ElseIf Sheet1.Range(“F2”).Value = “Great Britain” Then
Debug.Print “GBR”
ElseIf Sheet1.Range(“F2”).Value = “India” Then
Debug.Print “IND”
Else
Debug.Print “JAP”
End If
& “ IMPORT BACS " & Format(Date, "yyyymmdd") & ".csv", FileFormat:= _
        xlCSV, CreateBackup:=False
End Sub



  • @HighPerformanceMark probably some VBA for Excel. But you are right, tags needs to be properly set – Cid Aug 06 '19 at 09:31
  • Sorry, this is VBA for Excel. – Sockpuppet Aug 06 '19 at 09:40
  • Do you already know how to get the content of the cell F2 ? – Cid Aug 06 '19 at 09:52
  • You can have it in two ways. 1) Set up an additional column which contains the shortened version and then reference your code there. 2) Do it in the background but I suggest you use `Select Case`. Welcome to stackoverflow. Also, please include your attempt(s) (code you've written) to solve you're problem so we can focus on specific issues only. – L42 Aug 06 '19 at 09:52
  • Looking at that Code!! You need to get rid of all those Select & Activate. – Mikku Aug 06 '19 at 10:09
  • Obligatory link to [how to avoid using Select in VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – Nacorid Aug 06 '19 at 11:11

3 Answers3

0

Maybe you can try stuff like this :

How does this work,

Firstly we initialise the Code as JAP, Then we will check if the Value from F2 is equal to United States Great Britain or India if it is equal to one of them you the code will be updated and be for exemple USA..

Sub tryme()

Dim Code As String

Code = "JAP"
If Cells(2, "F").Value = "United States" Then Code = "USA"
If Cells(2, "F").Value = "Great Britain" Then Code = "GBR"
If Cells(2, "F").Value = "India" Then Code = "IND"

With ActiveWorkbook
.SaveAs Filename:="C:\My documents\" & Code & "File" & Format(Date, "yyyymmdd") & ". xlsx"
End With

End Sub

NOTE : If you want to do this for each cell of your F Column You will have to use a loop

You will also need to avoid Select your Macro will be quite faster !

TourEiffel
  • 4,034
  • 2
  • 16
  • 45
0

Change:

  • Sheet Name

    Dim val As String

    With ActiveWorkbook.Worksheets("SHeet_Name").Range("F2")
        If InStr(1, .Value, "United States") > 0 Then
            val = "USA"
        ElseIf InStr(1, .Value, "Great Britain") > 0 Then
            val = "GBR"
        ElseIf InStr(1, .Value, "India") > 0 Then
            val = "IND"
        Else: val = "JAP"
        End If
    End With

    ActiveWorkbook.SaveAs fileName:="C:\My documents\" & val & "_File_" & Format(Date, "yyyymmdd") & ". xlsx"
Mikku
  • 6,538
  • 3
  • 15
  • 38
0

You could use Select Case

Option Explicit

Sub test()

    Dim Country As String, Abbreviation As String

    With ThisWorkbook.Worksheets("Sheet1").Range("F2")

        Country = .Value

        Select Case Country
            Case Is = "United States"
                Abbreviation = "USA"
            Case Is = "Great Britain"
                Abbreviation = "GBR"
            Case Is = "India"
                Abbreviation = "IND"
            Case Else
                Abbreviation = "JAP"
        End Select

        Debug.Print Abbreviation

    End With

End Sub
Error 1004
  • 7,877
  • 3
  • 23
  • 46