Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Problem
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! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Problem
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.A.Tyler" wrote: 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! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Problem
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? "JLGWhiz" wrote: 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.A.Tyler" wrote: 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! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Problem
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.A.Tyler" wrote: 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? "JLGWhiz" wrote: 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.A.Tyler" wrote: 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! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro Problem
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. "JLGWhiz" wrote: 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.A.Tyler" wrote: 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? "JLGWhiz" wrote: 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.A.Tyler" wrote: 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! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|