Useful vba code snipits

VBA code to find eight digit number beginning with 8 in a long string ?

Function FindEightDigitNumber(inputString As String) As String

  Dim regex As Object

  Set regex = CreateObject("VBScript.RegExp")

  ' Define the pattern for an eight-digit number starting with 8

  regex.Pattern = "\b8\d{7}\b"

  ' Check if a match is found

  If regex.Test(inputString) Then

    ' Return the first match

    FindEightDigitNumber = regex.Execute(inputString)(0)

  Else

    ' Return an empty string if no match is found

    FindEightDigitNumber = ""

  End If

End Function

Handy to change row colour

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Row > 1 Then ' Exclude header row

If Target.EntireRow.Interior.Color = RGB(0, 255, 0) Then

Target.EntireRow.Interior.Color = RGB(255, 255, 255) ' Change to white fill

Else

Target.EntireRow.Interior.Color = RGB(0, 255, 0) ' Change to green fill

End If

Cancel = True ' Prevent default behavior (editing cell) when double-clicking

End If

End Sub

And some more to use PowerShell script and excel

# Set the path to your Excel file

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

# Create a new Excel application

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the Excel file

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

# Reference the first sheet (you may need to adjust this based on your Excel file)

$worksheet = $workbook.Sheets.Item(1)

# Run first macro

$excel.Run("YourFirstMacroName")

# Run second macro

$excel.Run("YourSecondMacroName")

# Save the changes

$workbook.Save()

# Close Excel

$excel.Quit()

# Release the Excel objects from memory

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

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

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

# Remove any remaining Excel processes

Get-Process Excel | ForEach-Object { Stop-Process $_.Id -Force }

How to Add a filter to a cell in xl !!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  ' Check if only one cell is selected

  If Target.Cells.Count = 1 Then

    ' Check if the selected cell is not empty

    If Target.Value <> "" Then

      ' Toggle filter on and off based on the selected cell value

      If ActiveSheet.AutoFilterMode Then

        ActiveSheet.AutoFilterMode = False

      Else

        ActiveSheet.UsedRange.AutoFilter Field:=Target.Column, Criteria1:=Target.Value

      End If

    Else

      ' If the selected cell is empty, remove the filter

      ActiveSheet.AutoFilterMode = False

    End If

  End If

End Sub

And the latest find a string in multiple text files in a folder using PS ..

# Set the directory path where your text files are located

$directoryPath = "C:\Path\To\Your\Directory"

# Set the string you want to search for

$searchString = "YourSearchString"

# Get all text files in the specified directory

$textFiles = Get-ChildItem -Path $directoryPath -Filter *.txt

# Iterate through each text file and search for the specified string

foreach ($file in $textFiles) {

  $filePath = $file.FullName

  $content = Get-Content $filePath -Raw

  if ($content -match $searchString) {

    Write-Host "String found in file: $filePath"

  } else {

    Write-Host "String not found in file: $filePath"

  }

}

PS to delete dups

# Specify the path to the folder containing CSV files

$folderPath = "C:\Path\To\Your\Folder"

# Get a list of CSV files in the folder

$csvFiles = Get-ChildItem -Path $folderPath -Filter *.csv

# Create a hashtable to track file hashes

$fileHashes = @{}

# Iterate through each CSV file

foreach ($csvFile in $csvFiles) {

  # Calculate the hash of the file content

  $fileContent = Get-Content $csvFile.FullName -Raw

  $fileHash = Get-Hash -InputObject $fileContent

  # Check if the hash is already in the hashtable

  if ($fileHashes.ContainsKey($fileHash)) {

    # Duplicate found, delete the file

    Remove-Item $csvFile.FullName -Force

    Write-Host "Deleted duplicate file: $($csvFile.Name)"

  } else {

    # Add the hash to the hashtable

    $fileHashes.Add($fileHash, $null)

  }

}

# Function to calculate the hash of a string

function Get-Hash {

  param (

    [Parameter(Mandatory = $true, ValueFromPipeline = $true)]

    [string]$InputObject

  )

  process {

    $hashAlgorithm = [System.Security.Cryptography.SHA256]::Create()

    $hashBytes = $hashAlgorithm.ComputeHash([System.Text.Encoding]::UTF8.GetBytes($InputObject))

    $hash = [BitConverter]::ToString($hashBytes) -replace '-'

    $hashAlgorithm.Dispose()

    $hash

  }

}

Refined

# Specify the folder path

$folderPath = "C:\Path\To\Your\Folder"

# Get all text files in the folder

$textFiles = Get-ChildItem -Path $folderPath -Filter *.txt

# Group files by content

$groupedFiles = $textFiles | Group-Object { Get-Content $_.FullName -Raw }

# Iterate through groups and delete duplicates

foreach ($group in $groupedFiles) {

  if ($group.Count -gt 1) {

    $group.Group | Select-Object -Skip 1 | ForEach-Object { Remove-Item $_.FullName -Force }

  }

}

Write-Host "Duplicate text files deleted successfully."

Sub DeleteRowsExceptFirstBankName()

  Dim ws As Worksheet

  Dim lastRow As Long, i As Long

  ' Set the worksheet where you want to delete rows

  Set ws = ThisWorkbook.Sheets("Sheet1") ' Update with your sheet name

  ' Find the last row with data in column A

  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

  ' Loop through rows starting from the second row (excluding header)

  For i = lastRow To 2 Step -1

    If ws.Cells(i, 1).Value <> "Bank Name" Then

      ' Delete the row if the value in column A is not "Bank Name"

      ws.Rows(i).Delete

    End If

  Next i

End Sub

Append files using PS

$folderPath = "C:\Path\To\Your\Folder"

$outputFilePath = "C:\Path\To\Your\Output\JoinedFile.txt"

Get-ChildItem -Path $folderPath -Filter *.txt | Get-Content | Out-File -FilePath $outputFilePath

For mail retrieval

# Load Outlook COM Object

$outlook = New-Object -ComObject Outlook.Application

$namespace = $outlook.GetNamespace("MAPI")

$inbox = $namespace.GetDefaultFolder(6) # 6 corresponds to the Inbox folder

# Create a text file for storing extracted data

$outputFilePath = "C:\Path\To\Your\Output\File.txt"

# Iterate through each email in the inbox

foreach ($email in $inbox.Items) {

  # Extract body, subject, and date

  $body = $email.Body

  $subject = $email.Subject

  $date = $email.ReceivedTime

  # Append data to the text file delimited by pipe symbol

  "$body|$subject|$date" | Out-File -Append -FilePath $outputFilePath

}

# Release Outlook COM Object

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

# Load Outlook COM Object

$outlook = New-Object -ComObject Outlook.Application

$namespace = $outlook.GetNamespace("MAPI")

$inbox = $namespace.GetDefaultFolder(6) # 6 corresponds to the Inbox folder

# Create a text file for storing extracted data

$outputFilePath = "C:\Path\To\Your\Output\File.txt"

# Iterate through each email in the inbox

foreach ($email in $inbox.Items) {

  # Extract body, subject, and date

  $body = $email.Body -replace "[\r\n]+", " " # Normalize line breaks

  $subject = $email.Subject

  $date = $email.ReceivedTime.ToString("yyyy-MM-dd HH:mm:ss") # Normalize date format

  # Append normalized data to the text file delimited by pipe symbol

  "$body|$subject|$date" | Out-File -Append -FilePath $outputFilePath

}

# Release Outlook COM Object

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

' append date and time to log file !

Function AppendDateAndTimeToLogFile()

  Dim filePath As String

  Dim logText As String

  Dim fileNumber As Integer

  ' Set the path to your log file

  filePath = "C:\Path\To\Your\LogFile.txt"

  ' Open the file for appending

  fileNumber = FreeFile

  Open filePath For Append As fileNumber

  ' Create the log text with current date and time

  logText = "Date and Time: " & Format(Now, "yyyy-mm-dd hh:nn:ss") & vbCrLf

  ' Append the log text to the file

  Print #fileNumber, logText

  ' Close the file

  Close fileNumber

End Function

PC running?

$computerName = "RemoteComputerName"

if (Test-Connection -ComputerName $computerName -Count 1 -Quiet) {

  Write-Host "$computerName is up and running."

} else {

  Write-Host "$computerName is not reachable."

}

Does file exist?

$file = "C:\Path\To\Your\File.txt"

if (Test-Path $file) {

  Write-Host "File exists. Continuing script..."

  # Add your script logic here to continue executing

} else {

  Write-Host "File does not exist. Ending script."

  # You can add any cleanup logic or exit the script here if needed

  exit

}

Sub IdentifyRowsWithSameValues()

  Dim lastRow As Long

  Dim i As Long

  Dim currentValue As Variant

  Dim rowNums As String

  ' Define the column you want to loop through

  Dim columnToCheck As String

  columnToCheck = "A" ' Change to your desired column

  ' Find the last row with data in the column

  lastRow = Cells(Rows.Count, columnToCheck).End(xlUp).Row

  ' Initialize rowNums to store row numbers where values are the same

  rowNums = ""

  ' Loop through the column

  currentValue = Cells(1, columnToCheck).Value

  For i = 2 To lastRow

    If Cells(i, columnToCheck).Value = currentValue Then

      ' If the current cell value is the same as the previous one, add its row number to rowNums

      rowNums = rowNums & ", " & i

    Else

      ' If the current cell value is different, update currentValue

      currentValue = Cells(i, columnToCheck).Value

    End If

  Next i

  ' Display row numbers where values are the same

  If Len(rowNums) > 0 Then

    MsgBox "Row numbers where values are the same: " & Mid(rowNums, 3)

  Else

    MsgBox "No rows found with the same values in column " & columnToCheck

  End If

End Sub