Simpler Macro

  • Thread starter Thread starter Joe via OfficeKB.com
  • Start date Start date
J

Joe via OfficeKB.com

Good Morning,
I currently have two separte macros but I'm trying to combine them but it's
going to require some different commands. What I need it to do is something
like this: start off we are in Summaryworkbook now if there is INV in column
D then do a straight search for 123 (which is in column E) in workbooks 1 - 7.
if there is a CM in column D then do a search for CM123 in workbooks 1-7 and
just go down the list from there. There are over 60000 of them to go through.
..Any ideas??
 
Sub Zurnprt2()
Const SummaryWorkbook = "ZurnOpenItemsspreadsheet.xls"
Const MainInvoiceCol = 5
Const MainPasteCol = 38
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14

Dim i As Integer


Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

For Each cell1 In InvoiceRange
InvoiceNumber = cell1.Value

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 2 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers


For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = .Range(Cells(1, WbkInvoiceCol), Cells(Lastrow,
WbkInvoiceCol))

For Each cell2 In InvoiceRange2

If (cell2.Value = "" & InvoiceNumber) Then 'add the prefix and
the number here

.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)
End If
Next cell2
End With
End If
Next wbk1
Next cell1
End Sub

Both are similiar the other one just doesn't take away two characters...


post the 2 codes that you have already working.........
susan
Good Morning,
I currently have two separte macros but I'm trying to combine them but it's
Click to expand...
[quoted text clipped - 7 lines]
Click to expand...
 
ok, joe
so the only thing that's different between the two macros is this area
of code?

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 2 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers

if your answer is yes, then you just need to devise some sort of if-
then test as to whether or not this section is performed.......
this is the only area where i could see you were deleting any
characters.
maybe this helps......
susan




Sub Zurnprt2()
Const SummaryWorkbook = "ZurnOpenItemsspreadsheet.xls"
Const MainInvoiceCol = 5
Const MainPasteCol = 38
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14

Dim i As Integer

Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

For Each cell1 In InvoiceRange
InvoiceNumber = cell1.Value

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 2 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers

For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = .Range(Cells(1, WbkInvoiceCol), Cells(Lastrow,
WbkInvoiceCol))

For Each cell2 In InvoiceRange2

If (cell2.Value = "" & InvoiceNumber) Then 'add the prefix and
the number here

.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)
End If
Next cell2
End With
End If
Next wbk1
Next cell1
End Sub

Both are similiar the other one just doesn't take away two characters...
post the 2 codes that you have already working.........
susan
Good Morning,
I currently have two separte macros but I'm trying to combine them but it's
Click to expand...
[quoted text clipped - 7 lines]
Click to expand...
Click to expand...
 
Ok the first macro looks for nothing but 123 which is great so it works. But
I wasn't sure on how to write the second one because it's not working the way
I planned, when the second macro runs it find's 123 then does a search for
CM3 (because it replaces the -2 charcters with the CM) and the crazy thing
it's finding matches!! which is incorrect. The whole reason I wanted the -2
is because there are other numbers like this XY456 and in our system it's
labled at CM456 so I figure just take two away with out thinking of the other
numbers without the letters in front. So I came up with this idea...I'm not
sure on how to write it though...
ok, joe
so the only thing that's different between the two macros is this area
of code?

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 2 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers

if your answer is yes, then you just need to devise some sort of if-
then test as to whether or not this section is performed.......
this is the only area where i could see you were deleting any
characters.
maybe this helps......
susan
Sub Zurnprt2()
Const SummaryWorkbook = "ZurnOpenItemsspreadsheet.xls"
Click to expand...
[quoted text clipped - 60 lines]
Click to expand...
 
Both are similiar the other one just doesn't take away two characters

so, not really, because one is searching for things & the other one
isn't......

why don't you post BOTH macro codes.
label one "THIS ONE RUNS FIRST"
and the other "THIS ONE RUNS SECOND"

then i (or anybody else) can see exactly what you're trying to do, in
the order you're trying to do it in.

re: finding incorrect matches, it only finds what you tell it to. so
there must be some kind of error in telling it what you want it to
find.
:)
susan



Ok the first macro looks for nothing but 123 which is great so it works. But
I wasn't sure on how to write the second one because it's not working the way
I planned, when the second macro runs it find's 123 then does a search for
CM3 (because it replaces the -2 charcters with the CM) and the crazy thing
it's finding matches!! which is incorrect. The whole reason I wanted the -2
is because there are other numbers like this XY456 and in our system it's
labled at CM456 so I figure just take two away with out thinking of the other
numbers without the letters in front. So I came up with this idea...I'm not
sure on how to write it though...




ok, joe
so the only thing that's different between the two macros is this area
of code?
Click to expand...
i = Len(InvoiceNumber) 'count the characters in the string
i = i - 2 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers
Click to expand...
if your answer is yes, then you just need to devise some sort of if-
then test as to whether or not this section is performed.......
this is the only area where i could see you were deleting any
characters.
maybe this helps......
susan
Sub Zurnprt2()
Const SummaryWorkbook = "ZurnOpenItemsspreadsheet.xls"
Click to expand...
[quoted text clipped - 60 lines]
Click to expand...
Click to expand...
 
RUN 1ST

Sub prt1()

Const SummaryWorkbook = "Test1.xls"
Const MainInvoiceCol = 4
Const MainPasteCol = 14
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14


Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

'the code below sets InvoiceRange to contain all the Invoice Numbers
'In column A
wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

'Now we loop though each of the Invoice Numbers in the 1st workbook
For Each cell1 In InvoiceRange

InvoiceNumber = cell1.Value
'Now Loop through all the open workbooks
For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

'sets InvoiceRange2 to contain the invoicenumbers in
'column E which is the 10th column
Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = _
.Range(Cells(1, WbkInvoiceCol), Cells(Lastrow, WbkInvoiceCol))

'Now loop through all the Invoice Number checking again
'Invoice Number found in 1st workbook
For Each cell2 In InvoiceRange2

'Compare Invoice Numbers
If (InvoiceNumber = cell2.Value) Then

'copy Cells if the Invoice Number matches
.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)


End If

Next cell2

End With

End If

Next wbk1
Next cell1

End Sub


Run 2nd


Sub prt2()
Const SummaryWorkbook = "Test1.xls"
Const MainInvoiceCol = 5
Const MainPasteCol = 14
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14

Dim i As Integer ' IT IS A GOOD IDEA TO ALWAYS DECLARE YOUR VARIABLES

Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

For Each cell1 In InvoiceRange
InvoiceNumber = cell1.Value

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 1 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers


For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = .Range(Cells(1, WbkInvoiceCol), Cells(Lastrow,
WbkInvoiceCol))

For Each cell2 In InvoiceRange2

If (cell2.Value = "" & InvoiceNumber) Then 'add the prefix and
the number here
'copy Cells if the Invoice Number matches
.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)
End If
Next cell2
End With
End If
Next wbk1
Next cell1
End Sub










Both are similiar the other one just doesn't take away two characters
Click to expand...

so, not really, because one is searching for things & the other one
isn't......

why don't you post BOTH macro codes.
label one "THIS ONE RUNS FIRST"
and the other "THIS ONE RUNS SECOND"

then i (or anybody else) can see exactly what you're trying to do, in
the order you're trying to do it in.

re: finding incorrect matches, it only finds what you tell it to. so
there must be some kind of error in telling it what you want it to
find.
:)
susan
Ok the first macro looks for nothing but 123 which is great so it works. But
I wasn't sure on how to write the second one because it's not working the way
Click to expand...
[quoted text clipped - 32 lines]
- Show quoted text -
Click to expand...
Click to expand...
 
ok i compared your code line by line..........
there is only that one section that is different.
and one constant is different - so i added a constant:

Sub prt1_and_2()

Const SummaryWorkbook = "Test1.xls"
Const MainInvoiceCol = 4
Const MainInvoiceCol2 = 5 '<--- this is new
Const MainPasteCol = 14
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14

Dim i As Integer

Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

For Each cell1 In InvoiceRange
InvoiceNumber = cell1.Value

'xxxxx start different in #2 but not in #1
i = Len(InvoiceNumber) 'count the characters in the string
i = i - 1 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers
'xxxxx end different

For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = .Range(Cells(1, WbkInvoiceCol),
Cells(Lastrow,
WbkInvoiceCol))

For Each cell2 In InvoiceRange2

If (cell2.Value = "" & InvoiceNumber) Then 'add the
prefix and
the number here
'copy Cells if the Invoice Number matches
.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)
End If
Next cell2
End With
End If
Next wbk1
Next cell1
End Sub

so that one area you need to make an if-then......
something like:
if invoicenumber.value = "YM" or _
invoicenumber.value = "WM" or _
invoicenumber.value = "XM" then

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 1 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers

end if

then continue your sub.

the only other problem i have that i can't figure out (because i don't
know exactly what you're doing here) is in sub #1 you have

Const MainInvoiceCol = 4
and in sub #2 this same const is =5.
so as i said, i added a 2nd constant, but you have to figure out when
& where it's appropriate to use MainInvoiceCol and MainInvoiceCol2.
i hope this helps, otherwise i give up. :)
& at this point you'd probably be HAPPY for me to give up!
susan



RUN 1ST

Sub prt1()

Const SummaryWorkbook = "Test1.xls"
Const MainInvoiceCol = 4
Const MainPasteCol = 14
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14

Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

'the code below sets InvoiceRange to contain all the Invoice Numbers
'In column A
wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

'Now we loop though each of the Invoice Numbers in the 1st workbook
For Each cell1 In InvoiceRange

InvoiceNumber = cell1.Value
'Now Loop through all the open workbooks
For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

'sets InvoiceRange2 to contain the invoicenumbers in
'column E which is the 10th column
Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = _
.Range(Cells(1, WbkInvoiceCol), Cells(Lastrow, WbkInvoiceCol))

'Now loop through all the Invoice Number checking again
'Invoice Number found in 1st workbook
For Each cell2 In InvoiceRange2

'Compare Invoice Numbers
If (InvoiceNumber = cell2.Value) Then

'copy Cells if the Invoice Number matches
.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)

End If

Next cell2

End With

End If

Next wbk1
Next cell1

End Sub

Run 2nd

Sub prt2()
Const SummaryWorkbook = "Test1.xls"
Const MainInvoiceCol = 5
Const MainPasteCol = 14
Const WbkInvoiceCol = 5
Const WbkStartCol = 1
Const WbkEndCol = 14

Dim i As Integer ' IT IS A GOOD IDEA TO ALWAYS DECLARE YOUR VARIABLES

Set wsh1 = Workbooks(SummaryWorkbook).Worksheets(1)

wsh1.Activate
Lastrow = wsh1.Cells(Rows.Count, MainInvoiceCol).End(xlUp).Row
Set InvoiceRange = wsh1. _
Range(Cells(1, MainInvoiceCol), Cells(Lastrow, MainInvoiceCol))

For Each cell1 In InvoiceRange
InvoiceNumber = cell1.Value

i = Len(InvoiceNumber) 'count the characters in the string
i = i - 1 'Remove 1 from the count to accommodate YM, WM or XM
InvoiceNumber = Right(InvoiceNumber, i) 'counting back from the right
'select only the numbers

For Each wbk1 In Application.Workbooks

If StrComp(wbk1.Name, SummaryWorkbook) <> 0 Then
With wbk1.Worksheets(1)
.Activate

Lastrow = .Cells(Rows.Count, WbkInvoiceCol).End(xlUp).Row
Set InvoiceRange2 = .Range(Cells(1, WbkInvoiceCol), Cells(Lastrow,
WbkInvoiceCol))

For Each cell2 In InvoiceRange2

If (cell2.Value = "" & InvoiceNumber) Then 'add the prefix and
the number here
'copy Cells if the Invoice Number matches
.Range(Cells(cell2.Row, WbkStartCol), _
Cells(cell2.Row, WbkEndCol)).Copy _
Destination:=wsh1.Cells(cell1.Row, MainPasteCol)
End If
Next cell2
End With
End If
Next wbk1
Next cell1
End Sub




so, not really, because one is searching for things & the other one
isn't......
Click to expand...
why don't you post BOTH macro codes.
label one "THIS ONE RUNS FIRST"
and the other "THIS ONE RUNS SECOND"
Click to expand...
then i (or anybody else) can see exactly what you're trying to do, in
the order you're trying to do it in.
Click to expand...
re: finding incorrect matches, it only finds what you tell it to. so
there must be some kind of error in telling it what you want it to
find.
:)
susan
Ok the first macro looks for nothing but 123 which is great so it works. But
I wasn't sure on how to write the second one because it's not working the way
Click to expand...
[quoted text clipped - 32 lines]
- Show quoted text -
Click to expand...
Click to expand...
Click to expand...
 
You must log in or register to reply here.

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

Sum work hours to hours & nearest 10th of an hour 14
Adding two characters in front plus three in back 8
HELP!! 2
Find a value in a sheet and replace it with another value if it matches 8
Find a variable cell within a worksheet using a macro. 3
Macro question 1
Put data by matching cell value with sheet name 2
Is this macro possible? 3

Back
Top