nav[aria-label="Primary Navigation"] { padding: 0; & ul { list-style: none; width: 100%; display: flex; flex-direction: row; justify-content: start; align-items: start; gap: 30px; padding: 0; & li { margin: 0; } & ul li { list-style: none; } } }

Child Item

Useful vba code snipits

gitch10

Just a place for useful vba code and discussion

Find more posts tagged with

Quick Links

Comments

gitch10

Sub RunPythonScript()
Dim pythonExePath As String
Dim pythonScriptPath As String
Dim shellCommand As String

' Path to your Python interpreter
pythonExePath = "C:\Path\To\Your\Python\python.exe"

' Path to your Python script
pythonScriptPath = "C:\Path\To\Your\Script\script.py"

' Build the command to run the script
shellCommand = pythonExePath & " " & pythonScriptPath

' Run the command
Shell shellCommand, vbNormalFocus

End Sub

gitch10

Sub UnlockAndReprotectAllWorksheets()
Dim ws As Worksheet
Dim password As String

' Replace with your actual password
password = "your_password"

' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Worksheets
    ' Unprotect the worksheet if it is protected
    If ws.ProtectContents Then
        On Error Resume Next
        ws.Unprotect Password:=password
        If Err.Number <> 0 Then
            MsgBox "Unable to unprotect worksheet: " & ws.Name
            Err.Clear
        End If
        On Error GoTo 0
    End If
Next ws

' Perform any necessary actions here
' For example, you can add your code to modify the worksheets

' Re-protect each worksheet with the same password
For Each ws In ThisWorkbook.Worksheets
    On Error Resume Next
    ws.Protect Password:=password
    If Err.Number <> 0 Then
        MsgBox "Unable to protect worksheet: " & ws.Name
        Err.Clear
    End If
    On Error GoTo 0
Next ws

MsgBox "All worksheets have been processed and re-protected."

End Sub

gitch10

try:
import pandas as pd
print("Pandas is installed. Version:", pd.version)
except ImportError:
print("Pandas is not installed.")

gitch10

Sub CompareAndWriteRecords()
Dim sourceWB As Workbook
Dim sourceWS As Worksheet
Dim otherWB As Workbook
Dim otherWS As Worksheet
Dim sourceRange As Range
Dim record As Range
Dim nextRow As Long

' Open the source workbook and worksheet
Set sourceWB = Workbooks.Open("Path_to_your_source_workbook.xlsx")
Set sourceWS = sourceWB.Sheets("SourceSheetName")

' Open the other workbook and worksheet
Set otherWB = Workbooks.Open("Path_to_your_other_workbook.xlsx")
Set otherWS = otherWB.Sheets("OtherSheetName")

' Define the range of records in the source worksheet
Set sourceRange = sourceWS.Range("A1:A40") ' Assuming your records are in column A and there are 40 records

' Loop through each record in the source worksheet
For Each record In sourceRange
    ' Check if the record exists in the other worksheet
    If WorksheetFunction.CountIf(otherWS.Range("A:A"), record.Value) = 0 Then
        ' Find the next available row in the source worksheet
        nextRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row + 1
        
        ' Write the record to the next available row in the source worksheet
        sourceWS.Cells(nextRow, "A").Value = record.Value
    End If
Next record

' Close the workbooks without saving changes
sourceWB.Close False
otherWB.Close False

End Sub

gitch10

Sub CheckRangeAndColumnU()
Dim rng As Range
Dim cell As Range
Dim isEmpty As Boolean
Dim colU As Range
Dim result As String

' Define the range to check
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:D10") ' Modify this as needed

' Assume the range is empty initially
isEmpty = True

' Loop through each cell in the range
For Each cell In rng
    If Not IsEmpty(cell.Value) Then
        isEmpty = False
        Exit For
    End If
Next cell

' If the range is empty, exit the subroutine
If isEmpty Then
    Exit Sub
End If

' Define the range for column U to check
Set colU = ThisWorkbook.Sheets("Sheet1").Range("U1:U" & ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "U").End(xlUp).Row)

' Assume there are no blank cells in column U initially
result = "N"

' Loop through each cell in column U
For Each cell In colU
    If IsEmpty(cell.Value) Then
        result = "Y"
        Exit For
    End If
Next cell

' Display the result
MsgBox result

End Sub

namenotavailablE

My experiment to generate a panel with clickable icons, a bit like a large version of the panel available on the right edge of the taskbar of Windows. It's starting to take shape and might be useful in VBA projects.

As Boards doesn't allow upload of XLSM workbooks, here's a link:

https://app.box.com/s/6axe62vsnjafa5s7zv2t71m9z5ieijso

All comments/ constructive criticism welcome!

gitch10

Define the path to your Python script

$pythonScriptPath = "path\to\your\script.py"

Run the Python script

python $pythonScriptPath

gitch10

import csv

def checkDups(listIn):

dictOut={}

n = len(listIn)

counter = 0 #Increments by 1 for each new record found

for i in range(n):

if listIn[i] not in dictOut: #Checks to see if the record is not in the list. If it is not, then it adds it to the dictionay as a key.

dictOut[listIn[i]]=counter

counter += 1

return list(dictOut.keys())

records=[]

with open("MOCK_DATA.csv", newline = '') as csvFile: #Adds each row in CSV to a list

reader=csv.reader(csvFile)

next(reader, None)

for row in reader:

temp = (', '.join(row))

records.append(temp)

uniqueRecords=checkDups(records)

with open('dataOut.csv', 'w', newline='') as csvfile:

spamwriter = csv.writer(csvfile)

for item in uniqueRecords:

spamwriter.writerow([item])

gitch10

import csv

def checkDups(listIn):
dictOut={}
n = len(listIn)

counter = 0 #Increments by 1 for each new record found

for i in range(n):
    if listIn[i] not in dictOut: #Checks to see if the record is not in the list. If it is not, then it adds it to the dictionay as a key.
        dictOut[listIn[i]]=counter 
        counter += 1

return list(dictOut.keys())

records=[]
with open("MOCK_DATA.csv", newline = '') as csvFile: #Adds each row in CSV to a list
reader=csv.reader(csvFile)
next(reader, None)
for row in reader:
temp = (', '.join(row))
records.append(temp)

uniqueRecords=checkDups(records)

with open('dataOut.csv', 'w', newline='') as csvfile:
spamwriter = csv.writer(csvfile)
for item in uniqueRecords:
spamwriter.writerow([item])

gitch10

Define the path to the CSV file

$csvPath = "path\to\your\file.csv"

Define the path to the log file

$logPath = "path\to\your\log\file.log"

Read the CSV file

$csvData = Import-Csv -Path $csvPath -Delimiter "^"

Group the records by the fields you want to check for duplicates

$groupedData = $csvData | Group-Object -Property Field1, Field2, Field3

Filter out groups with only one record (i.e., non-duplicates)

$duplicateGroups = $groupedData | Where-Object { $_.Count -gt 1 }

Write duplicate records to the log file

foreach ($group in $duplicateGroups) {
$group.Group | Export-Csv -Path $logPath -Append -Delimiter "^" -NoTypeInformation
}

Write-Host "Duplicate records have been written to $logPath"

gitch10

Path to the input text file

$inputFile = "input.txt"

Path to the output text file for duplicate records

$outputFile = "duplicates.txt"

Read all lines from the input file

$lines = Get-Content $inputFile

Find duplicate lines

$duplicates = $lines | Group-Object | Where-Object { $.Count -gt 1 } | ForEach-Object { $.Group }

Output duplicate records to another text file

$duplicates | ForEach-Object { $_ | Out-File -Append $outputFile }

gitch10

Path to the input text file

$inputFile = "input.txt"

Path to the output text file for duplicate records

$outputFile = "duplicates.txt"

Read all lines from the input file

$lines = Get-Content $inputFile

Find duplicate lines

$duplicates = $lines | Group-Object | Where-Object { $.Count -gt 1 } | ForEach-Object { $.Group }

Output duplicate records to another text file

$duplicates | Out-File $outputFile

gitch10

let
Source = Excel.CurrentWorkbook(){[Name="YourTableName"]}[Content],
GroupedRows = Table.Group(Source, {"Field1", "Field2", "Field3"}, {{"Count", each Table.RowCount(_), type number}}),
AddedCustomColumn = Table.AddColumn(Source, "IsDuplicate", each if List.Contains(Table.SelectRows(GroupedRows, each [Field1] = [Field1] and [Field2] = [Field2] and [Field3] = [Field3])[Count], 1) then "Yes" else "No")
in
AddedCustomColumn

gitch10

Sub FindDuplicateRows()
Dim wsSource1 As Worksheet, wsSource2 As Worksheet, wsSource3 As Worksheet
Dim wsOutput As Worksheet
Dim data1 As Variant, data2 As Variant, data3 As Variant
Dim i As Long, j As Long
Dim dict1 As Object, dict2 As Object, dict3 As Object
Dim key As String
Dim duplicateFound As Boolean

' Set your source and output worksheets
Set wsSource1 = ThisWorkbook.Sheets("SourceSheet1")
Set wsSource2 = ThisWorkbook.Sheets("SourceSheet2")
Set wsSource3 = ThisWorkbook.Sheets("SourceSheet3")
Set wsOutput = ThisWorkbook.Sheets("OutputSheet")

' Clear previous results in output sheet
wsOutput.Cells.Clear

' Read data from each source sheet into arrays
data1 = wsSource1.UsedRange.Value
data2 = wsSource2.UsedRange.Value
data3 = wsSource3.UsedRange.Value

' Create dictionaries to store unique rows for each dataset
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
Set dict3 = CreateObject("Scripting.Dictionary")

' Loop through each row in the first dataset
For i = 2 To UBound(data1, 1)
    key = GetRowKeyFromArray(data1, i)
    If dict1.exists(key) Then
        ' If duplicate is found, output the row numbers to the output sheet
        wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet1) is a duplicate of Row " & dict1(key)
        duplicateFound = True
    Else
        dict1(key) = i
    End If
Next i

' Loop through each row in the second dataset
For i = 2 To UBound(data2, 1)
    key = GetRowKeyFromArray(data2, i)
    If dict2.exists(key) Then
        ' If duplicate is found, output the row numbers to the output sheet
        wsOutput.Cells(wsOutput.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet2) is a duplicate of Row " & dict2(key)
        duplicateFound = True
    Else
        dict2(key) = i
    End If
Next i

' Loop through each row in the third dataset
For i = 2 To UBound(data3, 1)
    key = GetRowKeyFromArray(data3, i)
    If dict3.exists(key) Then
        ' If duplicate is found, output the row numbers to the output sheet
        wsOutput.Cells(wsOutput.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet3) is a duplicate of Row " & dict3(key)
        duplicateFound = True
    Else
        dict3(key) = i
    End If
Next i

' Inform user when no duplicates are found
If Not duplicateFound Then
    MsgBox "No duplicate rows found.", vbInformation
End If

End Sub

Function GetRowKeyFromArray(data As Variant, rowNum As Long) As String
' Function to generate a unique key for a row from an array
Dim key As String
Dim i As Long

For i = LBound(data, 2) To UBound(data, 2)
    key = key & "|" & data(rowNum, i)
Next i

GetRowKeyFromArray = key

End Function

gitch10

Sub FindDuplicateRows()
Dim wsSource1 As Worksheet, wsSource2 As Worksheet, wsSource3 As Worksheet
Dim wsOutput As Worksheet
Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
Dim i As Long
Dim dict1 As Object, dict2 As Object, dict3 As Object
Dim key As String
Dim duplicateFound As Boolean

' Set your source and output worksheets
Set wsSource1 = ThisWorkbook.Sheets("SourceSheet1")
Set wsSource2 = ThisWorkbook.Sheets("SourceSheet2")
Set wsSource3 = ThisWorkbook.Sheets("SourceSheet3")
Set wsOutput = ThisWorkbook.Sheets("OutputSheet")

' Clear previous results in output sheet
wsOutput.Cells.Clear

' Get the last row of data in each source sheet
lastRow1 = wsSource1.Cells(wsSource1.Rows.Count, "A").End(xlUp).Row
lastRow2 = wsSource2.Cells(wsSource2.Rows.Count, "A").End(xlUp).Row
lastRow3 = wsSource3.Cells(wsSource3.Rows.Count, "A").End(xlUp).Row

' Create dictionaries to store unique rows for each dataset
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
Set dict3 = CreateObject("Scripting.Dictionary")

' Loop through each row in the first dataset
For i = 2 To lastRow1 ' Assuming row 1 contains headers
    key = GetRowKey(wsSource1.Rows(i))
    If dict1.exists(key) Then
        ' If duplicate is found, output the row numbers to the output sheet
        wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet1) is a duplicate of Row " & dict1(key)
        duplicateFound = True
    Else
        dict1(key) = i
    End If
Next i

' Loop through each row in the second dataset
For i = 2 To lastRow2 ' Assuming row 1 contains headers
    key = GetRowKey(wsSource2.Rows(i))
    If dict2.exists(key) Then
        ' If duplicate is found, output the row numbers to the output sheet
        wsOutput.Cells(wsOutput.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet2) is a duplicate of Row " & dict2(key)
        duplicateFound = True
    Else
        dict2(key) = i
    End If
Next i

' Loop through each row in the third dataset
For i = 2 To lastRow3 ' Assuming row 1 contains headers
    key = GetRowKey(wsSource3.Rows(i))
    If dict3.exists(key) Then
        ' If duplicate is found, output the row numbers to the output sheet
        wsOutput.Cells(wsOutput.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet3) is a duplicate of Row " & dict3(key)
        duplicateFound = True
    Else
        dict3(key) = i
    End If
Next i

' Inform user when no duplicates are found
If Not duplicateFound Then
    MsgBox "No duplicate rows found.", vbInformation
End If

End Sub

Function GetRowKey(row As Range) As String
' Function to generate a unique key for a row
Dim key As String
Dim i As Long
Dim colCount As Long

colCount = row.Columns.Count

For i = 1 To colCount
    key = key & "|" & row.Cells(1, i).Value
Next i

GetRowKey = key

End Function

gitch10

' Set your source and output worksheets
Set wsSource1 = ThisWorkbook.Sheets("SourceSheet1")
Set wsSource2 = ThisWorkbook.Sheets("SourceSheet2")
Set wsSource3 = ThisWorkbook.Sheets("SourceSheet3")
Set wsOutput = ThisWorkbook.Sheets("OutputSheet")

' Clear previous results in output sheet
wsOutput.Cells.Clear

' Get the last row of data in each source sheet
lastRow1 = wsSource1.Cells(wsSource1.Rows.Count, "A").End(xlUp).Row
lastRow2 = wsSource2.Cells(wsSource2.Rows.Count, "A").End(xlUp).Row
lastRow3 = wsSource3.Cells(wsSource3.Rows.Count, "A").End(xlUp).Row

' Loop through each row in the first dataset
For i = 2 To lastRow1 ' Assuming row 1 contains headers
    duplicateFound = False
    ' Check if this row is a duplicate of any previous row
    For j = 1 To i - 1
        If RowsAreEqual(wsSource1.Rows(i), wsSource1.Rows(j)) Then
            ' If duplicate is found, output the row numbers to the output sheet
            wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet1) is a duplicate of Row " & j
            duplicateFound = True
            Exit For
        End If
    Next j
Next i

' Loop through each row in the second dataset
For i = 2 To lastRow2 ' Assuming row 1 contains headers
    duplicateFound = False
    ' Check if this row is a duplicate of any previous row
    For j = 1 To i - 1
        If RowsAreEqual(wsSource2.Rows(i), wsSource2.Rows(j)) Then
            ' If duplicate is found, output the row numbers to the output sheet
            wsOutput.Cells(wsOutput.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet2) is a duplicate of Row " & j
            duplicateFound = True
            Exit For
        End If
    Next j
Next i

' Loop through each row in the third dataset
For i = 2 To lastRow3 ' Assuming row 1 contains headers
    duplicateFound = False
    ' Check if this row is a duplicate of any previous row
    For j = 1 To i - 1
        If RowsAreEqual(wsSource3.Rows(i), wsSource3.Rows(j)) Then
            ' If duplicate is found, output the row numbers to the output sheet
            wsOutput.Cells(wsOutput.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = "Row " & i & " (Sheet3) is a duplicate of Row " & j
            duplicateFound = True
            Exit For
        End If
    Next j
Next i

' Inform user when no duplicates are found
If Not duplicateFound Then
    MsgBox "No duplicate rows found.", vbInformation
End If

End Sub

Function RowsAreEqual(row1 As Range, row2 As Range) As Boolean
' Function to check if two rows are equal
Dim i As Long
Dim colCount As Long

colCount = row1.Columns.Count

RowsAreEqual = True
For i = 1 To colCount
    If row1.Cells(1, i).Value <> row2.Cells(1, i).Value Then
        RowsAreEqual = False
        Exit Function
    End If
Next i

End Function

gitch10

Find the dups !

Sub FindDuplicateRows()
Dim wsSource As Worksheet
Dim wsOutput As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Dim duplicateFound As Boolean

' Set your source and output worksheets
Set wsSource = ThisWorkbook.Sheets("SourceSheet")
Set wsOutput = ThisWorkbook.Sheets("OutputSheet")

' Clear previous results in output sheet
wsOutput.Cells.Clear

' Get the last row of data in the source sheet
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

' Loop through each row in the dataset
For i = 2 To lastRow ' Assuming row 1 contains headers
    duplicateFound = False
    ' Check if this row is a duplicate of any previous row
    For j = 1 To i - 1
        If RowsAreEqual(wsSource.Rows(i), wsSource.Rows(j)) Then
            ' If duplicate is found, output the row numbers to the output sheet
            wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = "Row " & i & " is a duplicate of Row " & j
            duplicateFound = True
            Exit For
        End If
    Next j
Next i

' Inform user when no duplicates are found
If Not duplicateFound Then
    MsgBox "No duplicate rows found.", vbInformation
End If

End Sub

Function RowsAreEqual(row1 As Range, row2 As Range) As Boolean
' Function to check if two rows are equal
Dim i As Long
Dim colCount As Long

colCount = row1.Columns.Count

RowsAreEqual = True
For i = 1 To colCount
    If row1.Cells(1, i).Value <> row2.Cells(1, i).Value Then
        RowsAreEqual = False
        Exit Function
    End If
Next i

End Function

gitch10

String into SQL

Sub AddNumbersToSQLCriteriaAndOutput()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim criteria As String
Dim conn As Object
Dim rs As Object
Dim strSQL As String

' Assuming the numbers are in column A starting from the second row
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

' Find the last row with data in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Initialize the criteria string
criteria = ""

' Loop through each cell in column A and add the number to the criteria string
For i = 2 To lastRow ' Assuming data starts from row 2
    If IsNumeric(ws.Cells(i, 1).Value) Then
        criteria = criteria & ws.Cells(i, 1).Value & ","
    End If
Next i

' Remove the trailing comma
If Len(criteria) > 0 Then
    criteria = Left(criteria, Len(criteria) - 1)
End If

' Your SQL statement with the criteria added
strSQL = "SELECT * FROM YourTable WHERE YourColumn IN (" & criteria & ");"

' Open a connection to your database (replace the connection string and provider as necessary)
Set conn = CreateObject("ADODB.Connection")
conn.Open "your_connection_string_here"

' Execute the SQL statement
Set rs = conn.Execute(strSQL)

' Paste the results into a specified column (e.g., column B starting from row 2)
ws.Range("B2").CopyFromRecordset rs

' Close the recordset and connection
rs.Close
conn.Close

End Sub

gitch10

Remove all alpha chars !

Function RemoveAlphaCharacters(inputString As String) As String
Dim resultString As String
Dim i As Integer

For i = 1 To Len(inputString)
    If Not IsAlpha(Mid(inputString, i, 1)) Then
        resultString = resultString & Mid(inputString, i, 1)
    End If
Next i

RemoveAlphaCharacters = resultString

End Function

Function IsAlpha(character As String) As Boolean
IsAlpha = character Like "[A-Za-z]"
End Function

gitch10

Sub CopyWordFiles()

Dim sourceFolder As String

Dim destinationFolder As String

Dim fileExtension As String

Dim objFSO As Object

Dim objFolder As Object

Dim objSubFolder As Object

Dim objFile As Object

' Define the source folder path

sourceFolder = "C:\SourceFolder\"

' Define the destination folder path

destinationFolder = "C:\DestinationFolder\"

' Define the file extension to search for

fileExtension = "*.doc*"

' Create a File System Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Get the source folder

Set objFolder = objFSO.GetFolder(sourceFolder)

' Loop through each file in the source folder

For Each objFile In objFolder.Files

' Check if the file has the specified extension

If objFSO.GetExtensionName(objFile.Path) Like "doc*" Then

' Copy the file to the destination folder

objFSO.CopyFile objFile.Path, destinationFolder

End If

Next objFile

' Recursively search through subfolders

For Each objSubFolder In objFolder.SubFolders

' Call a recursive function to search through subfolders

RecursiveSearch objSubFolder, destinationFolder

Next objSubFolder

MsgBox "File copy completed."

End Sub

Sub RecursiveSearch(ByVal objFolder As Object, ByVal destinationFolder As String)

Dim objFSO As Object

Dim objSubFolder As Object

Dim objFile As Object

' Create a File System Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Loop through each file in the current folder

For Each objFile In objFolder.Files

' Check if the file has the specified extension

If objFSO.GetExtensionName(objFile.Path) Like "doc*" Then

' Copy the file to the destination folder

objFSO.CopyFile objFile.Path, destinationFolder

End If

Next objFile

' Recursively search through subfolders

For Each objSubFolder In objFolder.SubFolders

RecursiveSearch objSubFolder, destinationFolder

Next objSubFolder

End Sub

gitch10

# Source and destination folders

$sourceFolder = "C:\SourceFolder"

$destinationFolder = "C:\DestinationFolder"

# Get all .doc and .docx files from the source folder

$files = Get-ChildItem $sourceFolder -Filter *.doc, *.docx

# Copy each file to the destination folder

foreach ($file in $files) {

Copy-Item $file.FullName -Destination $destinationFolder

}

gitch10

Sub ExportNamedRangeRowsToTextFile()

Dim filePath As String

Dim rowNum As Long

Dim colNum As Long

Dim delimiter As String

Dim fileNum As Integer

Dim cellValue As Variant

Dim namedRange As Range

' Set the file path where you want to save the text file

filePath = "C:\YourFolder\YourFile.txt"

' Define the delimiter

delimiter = "|"

' Set the named range

Set namedRange = ThisWorkbook.Names("YourNamedRange").RefersToRange

' Open a new text file for writing

fileNum = FreeFile

Open filePath For Output As #fileNum

' Loop through each row in the named range

For rowNum = 1 To namedRange.Rows.Count

' Loop through each column in the current row

For colNum = 1 To namedRange.Columns.Count

' Get the value of the current cell

cellValue = namedRange.Cells(rowNum, colNum).Value

' Write the cell value to the text file

If colNum > 1 Then

Print #fileNum, delimiter; cellValue;

Else

Print #fileNum, cellValue;

End If

Next colNum

' Move to the next line in the text file after each row

Print #fileNum,

Next rowNum

' Close the text file

Close #fileNum

MsgBox "Export complete."

End Sub

gitch10

Sub ExportSheet1RowsToTextFile()

Dim filePath As String

Dim rowNum As Long

Dim colNum As Long

Dim delimiter As String

Dim fileNum As Integer

' Set the file path where you want to save the text file

filePath = "C:\YourFolder\YourFile.txt"

' Define the delimiter

delimiter = "|"

' Open a new text file for writing

fileNum = FreeFile

Open filePath For Output As #fileNum

' Loop through each row in Sheet1

For rowNum = 1 To ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count

' Loop through each column in the current row

For colNum = 1 To ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count

' Get the value of the current cell

cellValue = ThisWorkbook.Sheets("Sheet1").Cells(rowNum, colNum).Value

' Write the cell value to the text file

If colNum > 1 Then

Print #fileNum, delimiter; cellValue;

Else

Print #fileNum, cellValue;

End If

Next colNum

' Move to the next line in the text file after each row

Print #fileNum,

Next rowNum

' Close the text file

Close #fileNum

MsgBox "Export complete."

End Sub

gitch10

Sub ExportNamedRangeToTextFile()

Dim filePath As String

Dim cell As Range

Dim delimiter As String

Dim fileNum As Integer

' Set the file path where you want to save the text file

filePath = "C:\YourFolder\YourFile.txt"

' Define the delimiter

delimiter = "|"

' Open a new text file for writing

fileNum = FreeFile

Open filePath For Output As #fileNum

' Loop through each cell in the named range

For Each cell In ThisWorkbook.Names("YourNamedRange").RefersToRange

' Write the cell value to the text file

Print #fileNum, cell.Value;

' Print the delimiter except for the last cell in each row

If cell.Column <> ThisWorkbook.Names("YourNamedRange").RefersToRange.Columns.Count Then

Print #fileNum, delimiter;

End If

Next cell

' Add a carriage return after each row

Print #fileNum,

' Close the text file

Close #fileNum

MsgBox "Export complete."

End Sub

gitch10

Sub ExportNamedRangeToTextFile()

Dim filePath As String

Dim cell As Range

Dim delimiter As String

Dim fileNum As Integer

' Set the file path where you want to save the text file

filePath = "C:\YourFolder\YourFile.txt"

' Define the delimiter

delimiter = "|"

' Open a new text file for writing

fileNum = FreeFile

Open filePath For Output As #fileNum

' Loop through each cell in the named range

For Each cell In ThisWorkbook.Names("YourNamedRange").RefersToRange

' Write the cell value to the text file

Print #fileNum, cell.Value;

' Print the delimiter except for the last cell in each row

If cell.Column <> ThisWorkbook.Names("YourNamedRange").RefersToRange.Columns.Count Then

Print #fileNum, delimiter;

End If

Next cell

' Close the text file

Close #fileNum

MsgBox "Export complete."

End Sub

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the name of the named range you want to use

$namedRange = "MyNamedRange"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the named range

$range = $worksheet.Range($namedRange)

# Get the row and column counts from the range

$rowCount = $range.Rows.Count

$columnCount = $range.Columns.Count

# Open or create the CSV file

$csvFile = New-Object -TypeName System.IO.StreamWriter -ArgumentList $csvFilePath

# Loop through each row in the range

for ($row = 1; $row -le $rowCount; $row++) {

$rowData = @()

# Loop through each column in the row

for ($col = 1; $col -le $columnCount; $col++) {

# Get the value of the cell and add it to the row data array

$cellValue = $range.Cells.Item($row, $col).Text

$rowData += $cellValue

}

# Convert the row data array to a pipe-separated string and write it to the CSV file

$csvFile.WriteLine($rowData -join "|")

}

# Close the CSV file

$csvFile.Close()

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($range) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the name of the named range you want to use

$namedRange = "MyNamedRange"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the named range

$range = $worksheet.Range($namedRange)

# Get the row and column counts from the range

$rowCount = $range.Rows.Count

$columnCount = $range.Columns.Count

# Open or create the CSV file

$csvFile = New-Object -TypeName System.IO.StreamWriter -ArgumentList $csvFilePath

# Loop through each row in the range

for ($row = 1; $row -le $rowCount; $row++) {

$rowData = @()

# Loop through each column in the row

for ($col = 1; $col -le $columnCount; $col++) {

# Get the value of the cell and add it to the row data array

$cellValue = $range.Cells.Item($row, $col).Text

$rowData += $cellValue

}

# Convert the row data array to a comma-separated string and write it to the CSV file

$csvFile.WriteLine($rowData -join ",")

}

# Close the CSV file

$csvFile.Close()

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($range) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the range of used cells in the worksheet

$usedRange = $worksheet.UsedRange

$rowCount = $usedRange.Rows.Count

$columnCount = $usedRange.Columns.Count

# Open or create the CSV file

$csvFile = New-Object -TypeName System.IO.StreamWriter -ArgumentList $csvFilePath

# Loop through each row in the worksheet

for ($row = 1; $row -le $rowCount; $row++) {

$rowData = @()

# Loop through each column in the row

for ($col = 1; $col -le $columnCount; $col++) {

# Get the value of the cell and add it to the row data array

$cellValue = $worksheet.Cells.Item($row, $col).Text

$rowData += $cellValue

}

# Convert the row data array to a comma-separated string and write it to the CSV file

$csvFile.WriteLine($rowData -join ",")

}

# Close the CSV file

$csvFile.Close()

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

Different approach to output

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the last row and column in the worksheet

$lastRow = $worksheet.UsedRange.Rows.Count

$lastColumn = $worksheet.UsedRange.Columns.Count

# Create a StringBuilder object to store CSV data

$stringBuilder = New-Object -TypeName System.Text.StringBuilder

# Iterate through each row in the worksheet

for ($rowIndex = 1; $rowIndex -le $lastRow; $rowIndex++) {

# Iterate through each column in the row

for ($colIndex = 1; $colIndex -le $lastColumn; $colIndex++) {

# Append cell value to StringBuilder object

$cellValue = $worksheet.Cells.Item($rowIndex, $colIndex).Text

$stringBuilder.Append("$cellValue,")

}

# Append newline character after each row

$stringBuilder.AppendLine()

}

# Export data to CSV file

$stringBuilder.ToString() | Out-File -FilePath $csvFilePath -Encoding utf8

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the range of data in the worksheet

$dataRange = $worksheet.UsedRange

# Export data to CSV file

$dataRange | Export-Csv -Path $csvFilePath -NoTypeInformation

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null