Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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! |
Thread Tools | Search this Thread |
Display Modes | |
|
|