View Full Version : Retention Report Automation

jdautel

09-09-2016, 08:45 AM

Hey guy's I'm working on creating an automated process of creating retention reports every month. I've been using VBA for about 2 months now and have no prior coding experience. This problem is proving a bit challenging though.

The way it works is like this, there's two columns (one is exported from QuickBooks, the other is from the last months retention report):

xx x

x y

y z

z a

a b

b c

c d

e ee

We want to make the columns match in alphabetical order and include all entries from each column. So it would look something like this:

x x

xx xx

y y

z z

a a

b b

c c

d d

e e

ee ee

I created a code to insert everything from the right column into the left column and it works. But it ignores what needs to be inserted from the left column into the right column, it also runs for freaking ever because it inserts cells down so many times it runs to the 17,000 line in excel (our retention report only has like 300 properties to give you an idea of how inefficient that is)

Option Explicit

Sub RetentionReport()

Dim cell As Range

For Each cell In Range("A2:A242")

If cell.Value = Range(cell.Address).Offset(0, 6).Value Then

Else

Range(cell.Address).Offset(0, 6).Copy

cell.Insert shift:=xlDown

End If

Next cell

End Sub

Any ideas?

Any ideas? As soon as the first insert occurs, there will be no more matching cells so every x cell gets inserted into the xx column.

Issues:

Even though both lists are sorted alphabetically, they are not paired up.

x and xx do not correlate to left and right, like Cell and Cell.Offset(, 6) do. I will assume that x = Cell and xx = the offset.

You haven't said which list is complete. I will assume that both lists contain some values that the other does not.

Assuming that you want Column A to be the complete list: Presorting is not needed.

Sub AddToA()

Dim Cel As Range

Dim Found As Range

'Uncomment next line after testing

'Application.ScreenUpdating = False

For Each Cel in Range(Range("G2"), Cells(Rows.Count, "G").End(xlUp))

Set Found = Range("A:A").Find(Cel)

If Found Is Nothing Then Cells(Row.Count, "A").End(xlUp).Offset(1) = Cel

Next Cel

Application.ScreenUpdating = True

End Sub

jdautel

09-09-2016, 10:26 AM

Hmm, I tried this and it didn't return anything

Can you explain what's going on in it?

I understand that for each cell in the entire G range it is setting the variable found equal to something in range a, I don't understand what the find(cell) function is doing. I also don't understand what the

"If Found is Nothing Then Cells(Row.Count, "A").end(xlup).offset(1)=Cell"

does.

Option Explicit

Sub addtoa()

Dim cell As Range

Dim found As Range

Application.ScreenUpdating = False

For Each cell In Range(Range("G2"), Cells(Rows.Count, "G").End(xlUp))

Set found = Range("A:A").Find(cell)

If found Is Nothing Then

Cells(Rows.Count, "A").End(xlUp).Offset(1) = cell

End If

Next cell

Application.ScreenUpdating = True

End Sub

It doesn't matter which column is updated as long as one of them is updated correctly to put into our retention report. I've also figured out a possibly easier way of doing it: Cutting all the values in column G and pasting them below the values in column A. Then sorting column A alphabetically. Then running a macro removing all duplicate values in column A. That should give us the right answer as well.

I appreciate your help!

Cutting all the values in column G and pasting them below the values in column A. Then sorting column A alphabetically.

Then Excel Menu Data >> Filter >> Advanced Filter >. Filter in place, Unique records only.

I understand that for each cell in the entire G range it is setting the variable found equal to something in range a, I don't understand what the find(cell) function is doing. I also don't understand what the

"If Found is Nothing Then Cells(Row.Count, "A").end(xlup).offset(1)=Cell"

does.

.Find looks for a cell in A with the Value of the "Cell" variable. If it finds one, it sets The Range variable "Found" to be that "A" cell. Not the "A" cell value, but the "A" cell itself. If Found is nothing, then it didn't find a matching value.

Cells(Row.Count, "A") is the cell at the very bottom of the sheet in Column "A".

.End(xlUp) is the same as selecting a cell and pressing Ctrl+ Arrow Up.

.Offset(1) is the cell below the selection

Cells(Row.Count, "A").end(xlup).offset(1)

Means start in the bottom cell of the Column, go up till the first non-empty cell and select the cell under that.

"= Cell" Means make its value the same as the working cell in G.

.Find looks for a Cell (Range) that contains the value searched for. A Search for "B" will find "AbC"

Setting any Variable Type other than a Range with Find, will Raise an Error if the Value is not found.

Works sometimes, but fails Drastically if "xyzABCuvw" is not present

Dim X as String

X = Range("A:A").Find("abc").Value

Find is Case insensitive.

Find defaults to looking at parts of values, can be made to lookat the whole value.

jdautel

09-09-2016, 02:46 PM

So

if found=nothing

is saying if that cell isn't found in column A

then it will put that cell value at the BOTTOM of column A? And then you can just sort accordingly?

So

if found=nothing

is saying if that cell isn't found in column A

then it will put that cell value at the BOTTOM of column A? And then you can just sort accordingly?

Yes.

jdautel

09-12-2016, 09:04 AM

My final code working beautifully. Thanks Sam!

Option Explicit

Sub automatedreport()

Dim cell As range

Dim found As range

Application.ScreenUpdating = False

For Each cell In range(range("C2"), cells(Rows.Count, "C").End(xlUp))

'determine the size of range C and look at each cell within that range

Set found = range("A:A").Find(cell)

'search to check if each cell in range C2:Cwhatever equals any cell in range A

If found Is Nothing Then

'if the cell value can’t be find in x then copy that value to the bottom of column A

cells(Rows.Count, "A").End(xlUp).Offset(1) = cell

End If

Next cell

'Sort column A alphabetically

range("A1") = "Index"

Columns("A:A").Sort key1:=range("A2"), order1:=xlAscending, Header:=xlYes

For Each cell In range(range("A2"), cells(Rows.Count, "A").End(xlUp))

'set the range for A to do a vlookup for new monthly contract values

cell.Offset(0, 1) = Application.VLookup(cell.Value, range("C2:D300"), 2, False)

Next cell

'if there’s a property that cancelled it will have a #N/A value, this replaces all NA’s with a 0

cells.Replace "#N/A", 0, xlWhole

'if there’s any value with a “” value then replace that with a 0 as well

For Each cell In range(range("A2"), cells(Rows.Count, "A").End(xlUp))

If cell.Offset(0, 1) = "" Then

cell.Offset(0, 1) = 0

End If

Next cell

Application.ScreenUpdating = True

End Sub

It looks as if columns(C:D) are identicel to columns(A:B). What's the point ?

jdautel

09-13-2016, 06:50 AM

Not quite snb. You can try the code plugged into a worksheet but basically I am taking all cell values from column C that are unique from column A and adding them to column A. Then I am sorting alphabetically. Next I am using a vlookup to find all the values in column D and placing them with the corresponding column A cell in column B. If it can't find that value in column C, it puts in a 0.

So neither column A or Column C will hold the same values but any value in column C will be included in column A after the macro is run; however, not any value in column A will be included in column C.

jdautel

09-13-2016, 06:50 AM

The best way is to just run the code yourself as an example. I'm terrible at explaining haha

But it still don't see the point in doing this.

Next I am using a vlookup to find all the values in column D

If found Is Nothing Then _

cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(,2) = Cell.Resize(,2)

Next Cell

'Sort A:B

End Sub

jdautel

09-13-2016, 07:36 AM

It's adding the new values from column C into Column A

Then it's sorting

Then it's finding the new values of monthly income from each.

This way it includes everything from column C and column A

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.