Forum Discussion

JoAvg's avatar
JoAvg
Brass Contributor
Jan 20, 2023
Solved

Macro mod - Change range and filename according to cell condition

I have this code running in sheet "AS_BUILT", all data in sheet FORMULAS.

I need to have the range change according to the following conditions:

When FORMULAS!B11=L101, L103, L111, L201, L203, or L211

The exported range will be FORMULAS!A46:C60 and

Filename=SL.txt

 

When FORMULAS!B11=L701 or L703

The  exported range will be FORMULAS!H46:J60 and

Filename=NET.txt

 

Previous code

Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("FORMULAS")
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range("A46:C60").Value
    For r = 1 To 15
        wt.Range("A" & r).Value = "'" & wt.Range("A" & r).Value
    Next r
    wb.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\AsBuilt\SL.txt", _
        FileFormat:=xlText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

Any help would be appreciated.

 

excel
Macros and VBA
office 365
  • HansVogelaar's avatar
    HansVogelaar
    Jan 20, 2023

    JoAvg 

    Here you go:

    Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Dim ra As String
    Dim fn As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("FORMULAS")
    Select Case ws.Range("B11").Value
        Case "L101", "L103", "L111", "L201", "L203", "L211"
            ra = "A46:C60"
            fn = "SL"
        Case "L701", "L703"
            ra = "H46:J60"
            fn = "NET"
        Case Else
            Beep
            Exit Sub
    End Select
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range(ra).Value
    For r = 1 To 15
        wt.Range("A" & r).Value = "'" & wt.Range("A" & r).Value
    Next r
    wb.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
        "\AsBuilt\" & fn & ".txt", FileFormat:=xlText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

2 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jan 20, 2023

    JoAvg 

    Here you go:

    Sub SaveRangeAsText()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Dim ra As String
    Dim fn As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set ws = Worksheets("FORMULAS")
    Select Case ws.Range("B11").Value
        Case "L101", "L103", "L111", "L201", "L203", "L211"
            ra = "A46:C60"
            fn = "SL"
        Case "L701", "L703"
            ra = "H46:J60"
            fn = "NET"
        Case Else
            Beep
            Exit Sub
    End Select
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wt = wb.Worksheets(1)
    wt.Range("A1:C15").Value = ws.Range(ra).Value
    For r = 1 To 15
        wt.Range("A" & r).Value = "'" & wt.Range("A" & r).Value
    Next r
    wb.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
        "\AsBuilt\" & fn & ".txt", FileFormat:=xlText
    wb.Close Savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Resources