Advertisement
If you have a new account but are having problems posting or verifying your account, please email us on hello@boards.ie for help. Thanks :)
Hello all! Please ensure that you are posting a new thread or question in the appropriate forum. The Feedback forum is overwhelmed with questions that are having to be moved elsewhere. If you need help to verify your account contact hello@boards.ie

Useful vba code snipits

Options
2»

Comments

  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Advertisement
  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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

    }



  • Registered Users Posts: 51 ✭✭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



  • Advertisement
  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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, j As Long
    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
    
    ' 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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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



  • Registered Users Posts: 51 ✭✭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 }



  • Registered Users Posts: 51 ✭✭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"



  • Advertisement
  • Registered Users Posts: 51 ✭✭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])



  • Registered Users Posts: 51 ✭✭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])



  • Registered Users Posts: 51 ✭✭gitch10


    Define the path to your Python script

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

    Run the Python script

    python $pythonScriptPath



Advertisement