Assistance Needed with Excel VBA Code for Color Formatting

malkoriche

New Member
Joined
Jun 19, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I need help with my code as I'm unable to get the colors at the end. I would appreciate it if someone could solve the problem.

The code iterates through each row in the specified data range.For each row, it checks if the keywords "beneficiary" and "sender" are present in column G (Description).If the keywords are found, the code retrieves the sender, beneficiary, and the corresponding amount (debit or credit).Next, it searches for a matching row within the data range where the beneficiary and sender are swapped.If a match is found, the code compares the debit and credit amounts.If the amounts match, it colors the debit or credit cell of the current row in green and the corresponding cell in the other row in green as well.If the amounts don't match, it colors the debit or credit cell of the current row in orange and the corresponding cell in the other row in orange as well.This visually highlights the matches and discrepancies between the debited and credited amounts in the Excel file.

Here are the columns used in the code:

Column G: Description (to search for keywords)Column A: SenderColumn D: BeneficiaryColumn L: Debit AmountColumn M: Credit Amount

Here is the code:

Sub BalanceThirdPartyAccounts()
Dim rng As Range
Dim cell As Range
Dim beneficiary As String
Dim sender As String
Dim amount As Double
Dim correspondingCell As Range

' Prompt the user to select the range of data to check
On Error Resume Next
Set rng = Application.InputBox("Select the range of data to check:", Type:=8)
On Error GoTo 0

' Check if the user cancelled the selection
If rng Is Nothing Then
MsgBox "Operation cancelled."
Exit Sub
End If

' Iterate through each cell in the specified range
For Each cell In rng
' Get the value of the cell in column G (Description)
Dim description As String
description = cell.Offset(0, 6).Value

' Search for keywords in the description
If InStr(1, description, "beneficiary", vbTextCompare) > 0 And InStr(1, description, "sender", vbTextCompare) > 0 Then
' Get the sender and beneficiary
sender = cell.Offset(0, -6).Value
beneficiary = cell.Offset(0, -9).Value

' Search for the corresponding amount (debit or credit)
For Each correspondingCell In rng
If correspondingCell.Value = beneficiary And correspondingCell.Offset(0, -6).Value = sender Then
' Check if the amount is in the debit column (L)
If Not IsEmpty(correspondingCell.Offset(0, -2).Value) Then
amount = correspondingCell.Offset(0, -2).Value ' Found debited amount
Else
amount = correspondingCell.Offset(0, -1).Value ' Found credited amount
End If
Exit For
End If
Next correspondingCell

' Check if the debited amount matches the credited amount
If Abs(amount - cell.Offset(0, 12).Value) < 0.01 Then
' The amount is balanced, color the debit cell in green
correspondingCell.Offset(0, -2).Interior.Color = RGB(0, 255, 0) ' Green
' Color the credit cell in green
cell.Offset(0, 12).Interior.Color = RGB(0, 255, 0) ' Green
Else
' There is a difference, color the debit cell in orange
correspondingCell.Offset(0, -2).Interior.Color = RGB(255, 165, 0) ' Orange
' Color the credit cell in orange
cell.Offset(0, 12).Interior.Color = RGB(255, 165, 0) ' Orange
End If
End If
Next cell
End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top