Macro Problem

M

M.A.Tyler

I'm using the Macro below, I have no idea how it works, but it dose what I
need it to do. However I use it in the same workbook everyday, and then save
it (save as) as that particular date. The trouble is once saved this macro
won't work, perhaps I didn't put it into the right module, or perhaps thats
the way it was designed to work, to only one name. Either way I'm
appreciative that someone (I've tried to contact them directly, but no luck)
took the time to help me, and write it. And would like to know if there is a
way to fix it? Also it appears that all of my saved workbooks are now
attempting to share this macro, is that normal?

Here is the code:

Option Explicit

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim SH2 As Worksheet
Dim Rng As Range
Dim copyRng As Range
Dim destRng As Range
Dim iRow As Long
Dim i As Long
Dim CalcMode As Long
Dim sStr As String
Const dVal As Double = 1

Set WB = Workbooks("Test.00.xls") '<<==== CHANGE

With WB
Set SH = .Sheets("Sheet1")
Set SH2 = .Sheets("Answers")
End With

With SH2
sStr = .Range("B3")
Set destRng = .Range("L4")
End With

With SH
iRow = LastRow(SH, .Columns("A:A"))
Set Rng = .Range("G1:BB" & iRow)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
..Calculation = xlCalculationManual
..ScreenUpdating = False
End With

With SH
For i = 1 To iRow
If LCase(.Cells(i, "D").Value) = LCase(sStr) _
And .Cells(i, "BA").Value = dVal Then
If copyRng Is Nothing Then
Set copyRng = .Range(.Cells(i, "G"), _
..Cells(i, "BB"))
Else
Set copyRng = _
Union(.Range(.Cells(i, "G"), _
..Cells(i, "BB")), copyRng)
End If
End If
Next i
End With

If Not copyRng Is Nothing Then
copyRng.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

XIT:

With Application
..Calculation = CalcMode
..ScreenUpdating = True
End With

End Sub

'--------------->
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Appreciate any ideas!
 
J

JLGWhiz

Notice on this line:

Set WB = Workbooks("Test.00.xls") '<<==== CHANGE

that there is a notation "<<====Change. This means the the Workbook name
which is in the parentheses is to be changed to the actual name of the
workbook that it resides in, or applies to. So, when you do a SaveAs and
change the name of the workbook, the code will not work in the newly named
workbook unless you change that name in the line of code.

Then, these two lines:

Set SH = .Sheets("Sheet1")
Set SH2 = .Sheets("Answers")

could cause problems if the SaveAs workbook does not contain sheets with the
names Sheet1 and Answers, but I would assume only the workbook name was
changed with the SaveAs and not any of the sheet names.

If Workbooks("Test.00.xls") is open when you try to run the code from
another workbook, it might execute, otherwise you should get an error message
saying "Subscript out of bounds"
 
M

M.A.Tyler

Originally I had to change the workbook name to have it work properly, so I
am aware of that. The sheet1! & Answers! part should be no problem as the're
all the same workbook (with the same sheets) just saved to different names.
Is there anyway to automate the >Set WB= line to change to the saved name?
 
J

JLGWhiz

Is there anyway to automate the >Set WB= line to change to the saved name?

I would think that Set WB = ActiveWorkbook would work as long as
you are always running the macro from the active workbook. The workbook name
would only be required if you want to run the code in one workbook but
manipulate the data in another.
 
M

M.A.Tyler

Can you explain the Option Explicit, and Public Sub portions? All of my other
saved workbooks now refer to "Test.00" in the Macro window? Thats not
happened before.
 

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

Top