Excel macros are killing me!

B

brogi_bear

New Member
Joined
Mar 3, 2022
Messages
12
Office Version
  1. 365
Platform
  1. Windows
Hi all... newbie here

I have been tasked to create a macro for HR regarding insurance bills in which i have to compare two different files- and they are not formatted the same (for example one has department codes, the other doesn't and has items in different rows and columns.) What both documents have in common though are names (first & last), the type of Premium (insurance plan type) and the total of that premium per person such as: Joe Dirt | $107.07 | Dental Plan. Although it would be ideal to replicate the dept code from one to another i can't figure how i can do that from different files. The end goal is to highlight the differences between both files and highlight in green if it matches, yellow if it doesn't match, and red if there is missing info. Does anyone know how i can achieve the end goal? or where i can start, as i cant find a formula that can meet these demands, i am starting to think it is impossible.

thanks!! I appreciate any insight and pointers!
 

Attachments

  • help.png
    help.png
    42.5 KB · Views: 18
Sort by date Sort by votes
That is the problem. The headers in downloadbill don’t match the plan types on list bill. If they don’t match, they can’t be compared.
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
mumps said:
That is the problem. The headers in downloadbill don’t match the plan types on list bill. If they don’t match, they can’t be compared.
Click to expand...
Would renaming the download bill columns to match the listbill plan type prior to running a macro be something we can do?

at the end of the day if there is a way to make this process easier it would be super helpful. or maybe a pointer on another way i could go at this?
 
Upvote 0
If you can do that, it would solve the problem. Upload a revised version of the file.
 
Upvote 0
Click here to download your file. Please note that I deleted the blank rows at the top. I had to modify a couple of the headers in downloadbill because they didn't match the plan type in List Bill. You should check to see if I missed any mismatches. I also added a column for the Department in downloadbill. Also, please note that you have to be consistent in how you enter your data. For example, in the original file you posted, there was only one space between the first and last names in downloadbill. In the file you last posted, there are two spaces between the first and last names. The current macro in Module1 is based on two spaces so whenever you enter names in column A of downloadbill, make sure that you use two spaces. If you want to change that to one space, the macro will have to be modified. Let me know how it works out.
VBA Code: 
Sub CompareData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Dim dlWS As Worksheet, lbWS As Worksheet, i As Long, fnd As Range, x As Long
    Set dlWS = Sheets("downloadbill")
    Set lbWS = Sheets("List Bill")
    v1 = dlWS.Range("A1", dlWS.Range("N" & Rows.Count).End(xlUp)).Resize(, 14).Value
    v2 = lbWS.Range("B2", lbWS.Range("K" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2)
        If Not dic.exists(v2(i, 1) & ", " & v2(i, 2)) Then
            dic.Add v2(i, 1) & ", " & v2(i, 2), v2(i, 3)
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        Else
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        End If
    Next i
    For i = 2 To UBound(v1)
        If dic.exists(v1(i, 1)) Then
            dlWS.Range("B" & i) = dic(v1(i, 1))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Click here to download your file. Please note that I deleted the blank rows at the top. I had to modify a couple of the headers in downloadbill because they didn't match the plan type in List Bill. You should check to see if I missed any mismatches. I also added a column for the Department in downloadbill. Also, please note that you have to be consistent in how you enter your data. For example, in the original file you posted, there was only one space between the first and last names in downloadbill. In the file you last posted, there are two spaces between the first and last names. The current macro in Module1 is based on two spaces so whenever you enter names in column A of downloadbill, make sure that you use two spaces. If you want to change that to one space, the macro will have to be modified. Let me know how it works out.
VBA Code: 
Sub CompareData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Dim dlWS As Worksheet, lbWS As Worksheet, i As Long, fnd As Range, x As Long
    Set dlWS = Sheets("downloadbill")
    Set lbWS = Sheets("List Bill")
    v1 = dlWS.Range("A1", dlWS.Range("N" & Rows.Count).End(xlUp)).Resize(, 14).Value
    v2 = lbWS.Range("B2", lbWS.Range("K" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2)
        If Not dic.exists(v2(i, 1) & ", " & v2(i, 2)) Then
            dic.Add v2(i, 1) & ", " & v2(i, 2), v2(i, 3)
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        Else
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        End If
    Next i
    For i = 2 To UBound(v1)
        If dic.exists(v1(i, 1)) Then
            dlWS.Range("B" & i) = dic(v1(i, 1))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Click to expand...
Wow, mumps you are really good! First- i appreciate your patience. Second, i apologize for the lack of detail my eye missed on that last spreadsheet. Is there any way we can make one for one space instead of two?

I also see what you mean some insurance plans aren't all there, i thought they were there. So at this point after running the macro everything that is not highlighted the plan is not on the other spreadsheet?

VBA looks super interesting is there any way you can maybe tell how i can start learning? i would love to see what each command did like, i knew there was "if/then," but i didn't know it can be used in such a way within excel.
 
Upvote 0
Click here for your file. The macro is now based on one space between the first and last names. There were also some names that had three spaces between the first and last names so I corrected those as well. After you run the macro, if the Benefit Plan Type is red in the List Bill sheet, it means that person is not enrolled in that type of plan. If it is green, that person is enrolled in that type of plan and if there is no colour, that person does not exist in the downloadbill sheet (Connor Hill as an example). I also modified the macro to automatically adjust if you insert more plans between column D and column O in the downloadbill sheet. If you do insert more plan types, make sure that you do so between columns D and O otherwise the macro will not work properly and that the plan names exactly match those in the List Bill sheet.
VBA Code: 
Sub CompareData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Dim dlWS As Worksheet, lbWS As Worksheet, i As Long, fnd As Range, x As Long, PT As Range
    Set dlWS = Sheets("downloadbill")
    Set lbWS = Sheets("List Bill")
    dlWS.UsedRange.Cells.Interior.ColorIndex = xlNone
    lbWS.UsedRange.Cells.Interior.ColorIndex = xlNone
    Set PT = dlWS.Rows(1).Find("Premium Type", LookIn:=xlValues, lookat:=xlWhole)
    v1 = dlWS.Range("A1", dlWS.Range("N" & Rows.Count).End(xlUp)).Resize(, PT.Column - 1).Value
    v2 = lbWS.Range("B2", lbWS.Range("K" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2)
        If Not dic.exists(v2(i, 1) & ", " & v2(i, 2)) Then
            dic.Add v2(i, 1) & ", " & v2(i, 2), v2(i, 3)
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        Else
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        End If
    Next i
    For i = 2 To UBound(v1)
        If dic.exists(v1(i, 1)) Then
            dlWS.Range("B" & i) = dic(v1(i, 1))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
I found that the best way to learn VBA on your own is to use on-line tutorials, searching the web for specific areas of interest and following forums such as this one. The volunteers on sites such as this one are invaluable at providing help. I would suggest you keep a file of codes that you find useful and in this way you can build up a library that you can refer to. A lot is also trail and error. The following links may be of help:

VBA for smarties

www.snb-vba.eu www.snb-vba.eu
excelmacromastery.com

Excel VBA Dictionary - A Complete Guide - Excel Macro Mastery

This post contains everything you need to know about using the VBA Dictionary. There are tons of code examples including a real world application.
excelmacromastery.com excelmacromastery.com
excelmacromastery.com

Excel VBA Array - The Complete Guide - Excel Macro Mastery

This post provides everything you need to know about the Excel VBA Array. Includes a quickVBA Array reference guide and 50+ VBA Array examples.
excelmacromastery.com excelmacromastery.com

The more you practise, the better your get at it. Good luck with it!!!!
 
Upvote 0
mumps said:
Click here for your file. The macro is now based on one space between the first and last names. There were also some names that had three spaces between the first and last names so I corrected those as well. After you run the macro, if the Benefit Plan Type is red in the List Bill sheet, it means that person is not enrolled in that type of plan. If it is green, that person is enrolled in that type of plan and if there is no colour, that person does not exist in the downloadbill sheet (Connor Hill as an example). I also modified the macro to automatically adjust if you insert more plans between column D and column O in the downloadbill sheet. If you do insert more plan types, make sure that you do so between columns D and O otherwise the macro will not work properly and that the plan names exactly match those in the List Bill sheet.
VBA Code: 
Sub CompareData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Dim dlWS As Worksheet, lbWS As Worksheet, i As Long, fnd As Range, x As Long, PT As Range
    Set dlWS = Sheets("downloadbill")
    Set lbWS = Sheets("List Bill")
    dlWS.UsedRange.Cells.Interior.ColorIndex = xlNone
    lbWS.UsedRange.Cells.Interior.ColorIndex = xlNone
    Set PT = dlWS.Rows(1).Find("Premium Type", LookIn:=xlValues, lookat:=xlWhole)
    v1 = dlWS.Range("A1", dlWS.Range("N" & Rows.Count).End(xlUp)).Resize(, PT.Column - 1).Value
    v2 = lbWS.Range("B2", lbWS.Range("K" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2)
        If Not dic.exists(v2(i, 1) & ", " & v2(i, 2)) Then
            dic.Add v2(i, 1) & ", " & v2(i, 2), v2(i, 3)
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        Else
            If Not IsError(Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)) Then
                x = Application.Match(v2(i, 1) & ", " & v2(i, 2), dlWS.Range("A:A"), 0)
                Set fnd = dlWS.Rows(1).Find(v2(i, 10), LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 4
                    If v2(i, 9) = v1(x, fnd.Column) Then
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 4
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 4
                    Else
                        dlWS.Cells(x, fnd.Column).Interior.ColorIndex = 6
                        lbWS.Cells(i + 1, 10).Interior.ColorIndex = 6
                    End If
                Else
                    lbWS.Cells(i + 1, 11).Interior.ColorIndex = 3
                End If
            End If
        End If
    Next i
    For i = 2 To UBound(v1)
        If dic.exists(v1(i, 1)) Then
            dlWS.Range("B" & i) = dic(v1(i, 1))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
I found that the best way to learn VBA on your own is to use on-line tutorials, searching the web for specific areas of interest and following forums such as this one. The volunteers on sites such as this one are invaluable at providing help. I would suggest you keep a file of codes that you find useful and in this way you can build up a library that you can refer to. A lot is also trail and error. The following links may be of help:

VBA for smarties

www.snb-vba.eu www.snb-vba.eu
excelmacromastery.com

Excel VBA Dictionary - A Complete Guide - Excel Macro Mastery

This post contains everything you need to know about using the VBA Dictionary. There are tons of code examples including a real world application.
excelmacromastery.com excelmacromastery.com
excelmacromastery.com

Excel VBA Array - The Complete Guide - Excel Macro Mastery

This post provides everything you need to know about the Excel VBA Array. Includes a quickVBA Array reference guide and 50+ VBA Array examples.
excelmacromastery.com excelmacromastery.com

The more you practise, the better your get at it. Good luck with it!!!!
Click to expand...
Thanks for the updated code! and the material/advise.

The code works great with that set of names, but if i change names (testing to see if new people are added) then a lot of items don't get highlighted as a some name were changed when i uploaded as well. is that because the code is set to work just with that set of people?
 

Attachments

  • mrexcel1.1.png
    mrexcel1.1.png
    4.1 KB · Views: 5
  • mrexcel1.2.png
    mrexcel1.2.png
    10.5 KB · Views: 6
Upvote 0
mumps said:
if there is no colour, that person does not exist in the downloadbill sheet (Connor Hill as an example)
Click to expand...
I'm not sure if this answers your question.
 
Upvote 0
mumps said:
I'm not sure if this answers your question.
Click to expand...
I was comparing with the file you sent and changed names on a number of cells on both sheets, Theresa and DeAndra i used as an example.. but only only some info is highlighted. So i was curious if the macro will only work with a set of names/values
 
Upvote 0
You must log in or register to reply here.

Similar threads

zookeepertx
  • Solved
Weird Excel quirks driving me crazy! Can anyone explain?
Replies
7
Views
171
zookeepertx
zookeepertx
A
  • Solved
Comparing two excel files for matching / mismatching rows (long text strings - match() wont work
Replies
4
Views
557
ahaye
A
L
  • Question
How to group small variations on data
2 3
Replies
22
Views
267
awoohaw
awoohaw
S
  • Question
Can a macro help create a user hierarchy?
Replies
7
Views
174
Akuini
Akuini
E
  • Question
Old XLSM files crashing Excel; looking for help to troubleshoot, please
Replies
9
Views
1K
jkpieterse
jkpieterse

Forum statistics

Threads
1,215,016
Messages
6,122,700
Members
449,092
Latest member
snoom82

Share this page

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