Hou would you optimize this code?

H

HammerJoe

Hi,

Here is the background:

I have a rather large database of thousands of rows starting at colum
BA:BH and the list starts at row : 3

BA contains the account#
BD the Date as Date
BG the CrossAttempt as Boolean
BH the Fruit. as String

I want to create a list starting at DA:DH row 8

This list will contain all the entries that match the date between the
FROMDATE (DB:4) and TODATE (DD4)

One Account can have several Fruits but I want it to be listed only
once in one line showing all the fruits list on DD,DE,DF,DG,DH

Thats it.

Here is my code:

StartRow = 3
With Sheets("Tracker")
BigListRowCount = StartRow
SmallListStartRowCount = 8
SmalllistRowCount = SmallListStartRowCount
SmallListAccountNumber = 0
'**************** will need to check that From date is earlier
than To date*****
'Match until end of the database
TotalAttempts = 0
Do While .Range("BD" & BigListRowCount) <> ""
'Found = False
'Match Date Between From and to and Cross = Yes
If .Range("BD" & BigListRowCount).Value
= .Range("DB4").Value And _
Click to expand...
.Range("BD" & BigListRowCount).Value <= .Range("DD4").Value
And _
.Range("BG" & BigListRowCount).Value = True Then
'If list is empty start one
If SmalllistRowCount = SmallListStartRowCount Then
Found = True
.Range("DA" & SmalllistRowCount).Value = .Range("BA" &
BigListRowCount).Value
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry"
End Select
.Range(TempColumnString & SmalllistRowCount).Value
= .Range(TempColumnString & SmalllistRowCount).Value + 1
Else
'Verify the list to see if account already exists
TempCountRow = SmalllistRowCount
Found = False
Do While TempCountRow >= SmallListStartRowCount
'if Found account in the list, add to the Policy type
value
If .Range("DA" & TempCountRow).Value = .Range("BA" &
BigListRowCount).Value Then
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry
.Range(TempColumnString & TempCountRow).Value
= .Range(TempColumnString & TempCountRow).Value + 1
Found = True
Exit Do
Else
TempCountRow = TempCountRow - 1
End If

Loop
'No account found in the list
If Found = False Then
.Range("DA" & SmalllistRowCount).Value = .Range("BA" &
BigListRowCount).Value
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry
.Range(TempColumnString & SmalllistRowCount).Value
= .Range(TempColumnString & SmalllistRowCount).Value + 1
Found = True
End If
End If
If Found = True Then
TotalAttempts = TotalAttempts + 1
SmalllistRowCount = SmalllistRowCount + 1
End If
End If
BigListRowCount = BigListRowCount + 1
Loop
End With

=====
It works, but I am no expert in coding and I was wondering if it could
be optimized to be faster/smaller?
Any sugestions are welcome.
Thanks
 
R

Roger Govier

Hi

Rather than coding, you could use a Pivot Table.

Place cursor in BA3>data>Pivot Table>Finish
On the new sheet with the PT Skeleton,
Drag Date to the Row area
Drag Account to the row area
Drag Cross Attempt to the Page area
Drag Fruit to the Column Area
Drag Fruit again to the data area

Use the dropdown on Page field to select Yes
Use dropdown on date to deselect All, and select the dates that you want

You will see numbers against each account code, where any fruits are
involved, the number being the count of those fruits.

If you did need the Text of the fruit to be extracted as you do in your
coding method, then some simple IF formulae could be used to write the names
out to another part of the sheet, where there is a number in the relevant
cell of the PT.
 
H

HammerJoe

Thanks for the sugestion to use Pivot Table.
It is a rather interesting table wizard.
 
H

HammerJoe

I guess my code is okay seeing that nobody has any sugestions to
simplify it. :)
This code works fine, with one exception.
I wanted to get the new list on a different sheet and I dont know how
I can use two different sheets inside the With Sheets loop.

I thought that maybe instead of ".Range(TempColumnString &
TempCountRow).Value
= .Range(TempColumnString & TempCountRow).Value + 1"
I could use : "Sheets(NewSheet).Range(TempColumnString &
TempCountRow).Value
= Sheets(NewSheet).Range(TempColumnString & TempCountRow).Value + 1"
to redirect to the new sheet but I get a Ref error.
Any sugestions?
Thanks
 
R

Roger Govier

Hi

I would set references to the 2 sheets at the beginning of your routine.

Dim wss as Worksheet, wsd as Worksheet
(I tend to use wss as the Source sheet and wsd as the Destination sheet)
Set wss = ThisWorkbook.Sheets(("Sheet1")
Set wsd = ThisWorkbook.Sheets("Sheet2")
(Change sheet names to suit your example)

Then refer explicitly to which sheet you want the action to take place

wsd..Range(TempColumnString & SmalllistRowCount).Value
 
R

Roger Govier

wsd..Range(TempColumnString & SmalllistRowCount).Value

Apologies, that should of course not have had two periods.
Corrected version

wsd.Range(TempColumnString & SmalllistRowCount).Value
 
S

Susan

hiya! i don't know about whether or not it's faster, but when i have
an area of coding that keeps repeating, i make it a separate code.
then you only have to have it written out once, and then also if you
make changes to it, you don't have to remember to change it in every
instance...........

like this:

-----------------------------------
StartRow = 3
With Sheets("Tracker")
BigListRowCount = StartRow
SmallListStartRowCount = 8
SmalllistRowCount = SmallListStartRowCount
SmallListAccountNumber = 0
'**************** will need to check that From date is earlier
than To date*****
'Match until end of the database
TotalAttempts = 0
Do While .Range("BD" & BigListRowCount) <> ""
'Found = False
'Match Date Between From and to and Cross = Yes
If .Range("BD" & BigListRowCount).Value

= .Range("DB4").Value And _
Click to expand...


.Range("BD" & BigListRowCount).Value <= .Range("DD4").Value
And _
.Range("BG" & BigListRowCount).Value = True Then
'If list is empty start one
If SmalllistRowCount = SmallListStartRowCount Then
Found = True
.Range("DA" & SmalllistRowCount).Value = .Range("BA"
&
BigListRowCount).Value
Select Case .Range("BH" & BigListRowCount).Value

call Select_my_Case

End Select
.Range(TempColumnString & SmalllistRowCount).Value
= .Range(TempColumnString & SmalllistRowCount).Value + 1
Else
'Verify the list to see if account already exists
TempCountRow = SmalllistRowCount
Found = False
Do While TempCountRow >= SmallListStartRowCount
'if Found account in the list, add to the Policy type
value
If .Range("DA" & TempCountRow).Value = .Range("BA" &
BigListRowCount).Value Then
Select Case .Range("BH" & BigListRowCount).Value

call Select_my_Case

.Range(TempColumnString & TempCountRow).Value
= .Range(TempColumnString & TempCountRow).Value + 1
Found = True
Exit Do
Else
TempCountRow = TempCountRow - 1
End If

Loop
'No account found in the list
If Found = False Then
.Range("DA" & SmalllistRowCount).Value = .Range("BA"
&
BigListRowCount).Value
Select Case .Range("BH" & BigListRowCount).Value

call Select_my_Case

.Range(TempColumnString & SmalllistRowCount).Value
= .Range(TempColumnString & SmalllistRowCount).Value + 1
Found = True
End If
End If
If Found = True Then
TotalAttempts = TotalAttempts + 1
SmalllistRowCount = SmalllistRowCount + 1
End If
End If
BigListRowCount = BigListRowCount + 1
Loop
End With


Private Sub Select_my_Case()
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry
End Sub
-----------------------------------------------
i might have messed up your coding somewhat, but you get the idea.
:)
susan
 
H

HammerJoe

I need help with this portion of the code:

'Verify the list to see if account already exists
TempCountRow = SmalllistRowCount
Found = False
Do While TempCountRow >= SmallListStartRowCount
'if Found account in the list, add to the Policy type
value
If .Range("DA" & TempCountRow).Value = .Range("BA" &
BigListRowCount).Value Then
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry
.Range(TempColumnString & TempCountRow).Value
= .Range(TempColumnString & TempCountRow).Value + 1
Found = True
Exit Do
Else
TempCountRow = TempCountRow - 1
End If

Loop
====
It works, but it seems to be very slow. What it does is it goes thru
the new list to verify that the account# is not already there.
This being Excel, isnt there just a command like
=MATCH(SmalllistRowStart,SmalllistRowCount, .Range("DA" &
TempCountRow).Value, .Range("BA" &
BigListRowCount).Value) where match(beginning of range, end of range,
value of the range to compare, to what?)

I need a faster routine than this, otherwise with several thousand of
entries it will take minutes to compute. :)
Thanks
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Combine Two Different Worksheet_Change codes 9
Remove a date in a cell by code 3
Need help-For loop 3
Any way to reduce/combine in this code? 2
Excel Macro - Speed increase suggestions needed. 2
Slow code 4
Advanced Filter problems using VBA in XL2007 2
Help with this macro 6

Top