CODEWITHSUNDEEP
excelvbarangeunion
larsinka
larsinka

Reputation: 21

Is this the correct way to union VBA range into one?

Im trying to export 4 columns into one .csv file. Therefore I want to combine all 4 columns into one range and export this range. Somehow rng only has one column. Why?

Set rng = Application.Union(Range("Berechnung!$A$10811:$A$39611"),Range("Berechnung!$BA$10811:$BC$39611"))

Thank you!

Upvotes: 0

Views: 1517

Answers (4)

Dy.Lee
Dy.Lee

Reputation: 7567

You can use a procedure that creates an array and converts it to csv as a parameter.

Sub ExportSheetsToCSV()

    Dim Ws As Worksheet
    Dim xcsvFile As String
    Dim vDB1 As Variant, vDB2 As Variant, vDB() As Variant
    Dim r As Long, i As Long, j As Integer
    Set Ws = ActiveSheet

    xcsvFile = CurDir & "\" & Ws.Name & ".csv"


    vDB1 = Range("Berechnung!$A$10811:$A$39611")
    vDB2 = Range("Berechnung!$BA$10811:$BC$39611")


    r = UBound(vDB1, 1)
    ReDim vDB(1 To r, 1 To 4)
    For i = 1 To r
        vDB(i, 1) = vDB1(i, 1)
        For j = 1 To 3
            vDB(i, j + 1) = vDB2(i, j)
        Next j
    Next i
    TransToCSV xcsvFile, vDB
    MsgBox ("Files Saved Successfully")
End Sub

Sub TransToCSV(myfile As String, vDB As Variant)

    Dim vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")

    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
         .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Upvotes: 0

Excel Hero
Excel Hero

Reputation: 14764

Your use of UNION is fine, but now you must account for the fact that the range has more than one area.

This answer uses YOUR code and extends it to work with the areas in the disjointed range.

Set rng = Union(Range("Berechnung!$A$10811:$A$39611"),Range("Berechnung!$BA$10811:$BC$39611"))

For i = 1 To rng.Rows.Count
    For a = 1 To rng.Areas.Count
        For j = 1 To rng.Areas(a).Columns.Count
            str = str & rng.Areas(a)(i, j).Value & " ,"
        Next
    Next
    Print #fNum, Left(str, Len(str) - 2)
    str = ""
Next

Upvotes: 2

CDP1802
CDP1802

Reputation: 16357

Option Explicit
Sub MyExportCsv()

    Const START_ROW = 10811
    Const END_ROW = 39611
    Const CSV_FILE = "export.csv"

    Dim ws As Worksheet, str As String, i As Long
    Dim rng As Range, cell As Range, count As Long

    Dim oFSO As Object, oFS As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFS = oFSO.CreateTextFile(CSV_FILE)

    Set ws = ThisWorkbook.Sheets("Sheet1")

    For i = START_ROW To END_ROW

        str = ws.Range("A" & i)
        Set rng = ws.Range("BA" & i & ":BC" & i)
        For Each cell In rng
           str = str & " ," & cell.Value
        Next
        oFS.writeline str
        count = count + 1

    Next
    oFS.Close

    MsgBox count & " records written to " & CSV_FILE, vbInformation, "Finished"

End Sub

Upvotes: 0

Gary's Student
Gary's Student

Reputation: 96781

You have a disjoint range. It is not easy to count the number of columns in this case. For example:

Sub dural()
    Dim r1 As Range, r2 As Range, rTot As Range, Column As Variant
    Dim kount As Long
    Set r1 = Range("A1:A10")
    Set r2 = Range("D1:E10")
    Set rTot = Union(r1, r2)

    MsgBox rTot.Columns.Count

    kount = 0
    For Each Column In rTot.Columns
        kount = kount + 1
    Next Column

    MsgBox kount
End Sub

The first MsgBox will report 1, the second MsgBox will report 3.

Upvotes: 1

Related Questions