PDA

View Full Version : Solved: An error with setting a wb. Why?



RonMcK
03-30-2011, 07:12 PM
MD, et al,

The short answer to my question is that I forgot to 'set' my wb and ws assignments. New code replaces what I first posted.

Here's where my original query began:

The next project that I have is to write code to move selected data from my Grade & "_INFO.xls" file to another named Grade & "_Diagnostic Assessment.xls". Here is what I have so far. I copied the wb1/wb2 (here, called wbInfo, wbDiag) from the code MD gave me for the last project. As the comment says, I'm getting an error that I don't follow. The files are open on my desktop and yet the code, here, is not recognizing the first one.

My goal at the moment is to have autofilter find me only those lines in INFO that have a particular Standard code associated with them. Once I have that I'll add in using "activecell" to identify which row of those filtered I want to use, and then use offset to get the various pieces of data to move to the Diagnostic Assessment worksheet/workbook.

Option Explicit
Sub Move_Data()
Dim wbInfo As Workbook, wsInfo As Worksheet, FilenameInfo As String, LastInfoRow As Long
Dim wbDiag As Workbook, wsDiag As Worksheet, FilenameDiag As String, LastDiagRow As Long
Dim Grade As String, std As String, LastInfoCol As Long, LastDiagCol As Long
Dim rngInfo As Range, rngDiag As Range, InfoCol As Long, DiagCol As Long
Dim wb1 As Workbook
' InfoFile = OpenFile("Info")
' DiagFile = OpenFile("Diag")

Grade = "G4"
Set wbInfo = Workbooks(Grade & "_INFO.xls") ' <<< Err 91:Object Var or With Block Var not set ??
Set wbInfo = Workbooks("G4_INFO.xls")
' Set wsInfo = wbInfo.Worksheet("INFO")
With wsInfo
Grade = Left(.Cells(2, 2).Value, 2)
LastInfoRow = .UsedRange.Rows
LastInfoCol = .UsedRange.Columns
InfoCol = .Range("F1").Column
Set rngInfo = .Range(Cells(2, 1)).Resize(LastInfoRow, LastInfoCol) 'Column T
std = .Range("F2").Text
End With

wbDiag = Workbooks(Grade & " - Diagnostic Assessment.xls")
wsDiag = wbDiag.Worksheets("DA NL " & Grade)
With wsDiag
LastDiagRow = .UsedRange.Rows
LastDiagCol = .UsedRange.Columns
DiagCol = .Range("T1").Column
Set rngDiag = .Range(Cells(2, 1)).Resize(LastDiagRow, LastDiagCol) 'Column F
' std = ActiveCell.Text
With rngInfo
.AutoFilter
.AutoFilter Field:=InfoCol, Criteria1:=std
If Not rngInfo Is Nothing Then
.SpecialCells (xlCellTypeVisible)
If Not rngInfo Is Nothing Then MsgBox "Nothing Selected. Try next Std.", vbOKOnly, "Filter INFO File"
End If
End With

End Sub


Advice and counsel is cheerfully sought. And, don't worry, I'll carve code out and place it in Subs and Functions as may be appropriate. Right now, a single file is adequate for testing.

Thanks,

RonMcK
03-30-2011, 09:06 PM
The autofilter is working, sort of. I expected it to display the list of items which match Criteria1. Instead, it's collasping them and showing one line; if I click the drop box on the search column, click my criteria value, and click ok, AutoFilter will finally show it to me.

Is my expectation wrong or am I failing to do something in my code?

Here's how things look at the moment:

Option Explicit
Sub Move_Data()
Dim wbInfo As Workbook, wsInfo As Worksheet, FilenameInfo As String, LastInfoRow As Long
Dim wbDiag As Workbook, wsDiag As Worksheet, FilenameDiag As String, LastDiagRow As Long
Dim Grade As String, std As String, LastInfoCol As Long, LastDiagCol As Long
Dim rngInfo As Range, rngDiag As Range, InfoCol As Long, DiagCol As Long
Dim wb1 As Workbook
' InfoFile = OpenFile("Info")
' DiagFile = OpenFile("Diag")

Grade = "G4"
Set wbInfo = Workbooks(Grade & "_INFO.xls")
Set wsInfo = wbInfo.Sheets("INFO")
With wsInfo
LastInfoRow = .UsedRange.Rows.Count
LastInfoCol = .UsedRange.Columns.Count
InfoCol = .Range("T1").Column
Grade = Left(.Range("B2").Text, 2)
Set rngInfo = .Range("A2").Resize(LastInfoRow, LastInfoCol) 'Column T
End With
Set wbDiag = Workbooks(Grade & " Diagnostic Assessment (2).xls")
Set wsDiag = wbDiag.Worksheets("DA - NL " & Grade)
With wsDiag
LastDiagRow = .UsedRange.Rows.Count
LastDiagCol = .UsedRange.Columns.Count
DiagCol = .Range("F1").Column
Set rngDiag = .Range("A3").Resize(LastDiagRow, LastDiagCol) 'Column F
' wsDiag has a list of unique Standards numbers; wsInfo has 1 or more instances of each Std code
' this next line gets a Std code for autofiltering the INFO list to show only lines w/ std codes
std = .Range("F3").Text ' std = SC.4.E.5.1 & by visual inspec the are 7 items
End With

' std = ActiveCell.Text

' what puzzles me is that the following code autofilters my Std Code but shows it collapsed as
' one row, to see all selected, I have to click the dropdown arrow and select my Std Code and
' click okay. In Bob's (XLD's) example all of the selection appears (or so it seems). Am I not
' doing something necessary?
With rngInfo
.AutoFilter
.AutoFilter Field:=InfoCol, Criteria1:=std, VisibleDropDown:=True
On Error Resume Next
If Not rngInfo Is Nothing Then
.SpecialCells (xlCellTypeVisible)
If rngInfo Is Nothing Then MsgBox "Nothing Selected. Try next Std.", vbOKOnly, "Filter INFO File"
End If
On Error GoTo 0
End With

End Sub


Thanks,

mdmackillop
03-31-2011, 05:27 AM
Q1: works for me, but you're missing an End With; Check your WB name
Q2; Can you post sample data?

RonMcK
03-31-2011, 02:00 PM
Malcolm,

Here is the current iteration of my program and a new called Sub to write selected data from G4_INFO.xls to G4 Diagnostic Assessment.xls

Eventually, I want my program to handle 3 scenarios:

Fill out the diagnostic assessment from first line to last line, stepping through the lines.
Allow the user to enter a specific standard and replace the current entry with a different one.
In (1) above allow the user to resume entry on a partially complete list.My current goal is that of getting (1) working.

The process is to look at the Diagnostic Assessment list and get a standard number. Pass that standard number to code that will use AutoFilter with that standard number to get the subset of the rows in the INFO.xls file with that standard. Have the Code pause, ask the user to select the desired row in INFO.xls to transfer to that standard's row in the Diagnositic Assessment sheet. Once the selection is made, resume processing, looping back to get the next standard from the Diagnostic Assessment list. And repeat until all standards are updated in the Diagnostic Assssment list.

There are 2 Subs at the moment, Find_Data and Move_Data

Option Explicit
Public wbInfo As Workbook, wsInfo As Worksheet, FilenameInfo As String, LastInfoRow As Long
Public wbDiag As Workbook, wsDiag As Worksheet, FilenameDiag As String, LastDiagRow As Long
Public Grade As String, std As String, LastInfoCol As Long, LastDiagCol As Long
Public rngInfo As Range, rngDiag As Range, InfoCol As Long, DiagCol As Long
Public wb1 As Workbook, rng As Range, MyRow As Long

Sub Find_Data()
' InfoFile = OpenFile("Info")
' DiagFile = OpenFile("Diag")

Grade = "G4"
Set wbInfo = Workbooks(Grade & "_INFO.xls")
Set wsInfo = wbInfo.Sheets("INFO")
With wsInfo
LastInfoRow = .UsedRange.Rows.Count
LastInfoCol = .UsedRange.Columns.Count
InfoCol = .Range("T1").Column
Grade = Left(.Range("B2").Text, 2)
Set rngInfo = .Range("A2").Resize(LastInfoRow, LastInfoCol) 'Column T
End With
Set wbDiag = Workbooks(Grade & " Diagnostic Assessment (2).xls")
Set wsDiag = wbDiag.Worksheets("DA - NL " & Grade)
With wsDiag
LastDiagRow = .UsedRange.Rows.Count
LastDiagCol = .UsedRange.Columns.Count
DiagCol = .Range("F1").Column
Set rngDiag = .Range("A3").Resize(LastDiagRow, LastDiagCol) 'Column F
' wsDiag has a list of unique Standards numbers; wsInfo has 1 or more instances of each Std code
' this next line gets a Std code for autofiltering the INFO list to show only lines w/ std codes
MyRow = 3
Do While MyDiagRow <= LastDiagRow

If .Range("B" & MyDiagRow).Text = "" Then Exit Do
std = .Range("F" & MyDiagRow).Text
' std = "SC.4.P.10.1"

' Application.ScreenUpdating = False

With wsInfo

.Names.Add Name:="std", RefersToR1C1:="='DA - NL G4'!R3C6"
.Names("std").Comment = ""
.Rows(1).Insert
.Columns("U").Insert
.Range("U1").Value = "Temp"
' LastInfoRow = .UsedRange.Rows.Count
Set rng = .Range("U2").Resize(LastInfoRow - 1)
rng.FormulaR1C1 = "=(RC[-1]=std)" ' ONLY WORKS IF 'std' IS DEFINED NAME
Set rng = .Range("U1").Resize(LastInfoRow)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

' Need code here to pause while I select a cell in the above AutoFilter selection
' So, How might I do the pause and signal that I'm ready for it to resume processing?
' Then resume

Move_Data (MyDiagRow)

.Columns("U").Delete
.Rows(1).Delete
End With

' Application.ScreenUpdating = True

MyDiagRow = MyDiagRow + 1
Loop
End With

End Sub

And, here's Move_Data:
Private Sub Move_Data(MyDiagRow as Long)
Dim MyInfoRow As Long

If ActiveCell.Worksheet.Name <> "INFO" Then Exit Sub
If ActiveCell.Row > LastInfoRow Then Exit Sub

MyInfoRow = ActiveCell.Row
std = wsInfo.Range("T" & MyInfoRow).Value
' std = "SC.4.P.10.1"
' THE FOLLOWING CODE IS NOT WORKING AT THE MOMENT:
With wsDiag
.Range("B" & MyDiagRow).Cells("B" & MyDiagRow).Value = _
wsInfo.Range("B" & MyInfoRow).Cells("B" & MyInfoRow).Value ' LO#
.Range("C" & MyDiagRow).Text = wsInfo.Range("E" & MyInfoRow).Text ' Short LO Code
.Range("G" & MyDiagRow).Text = wsInfo.Range("F" & MyInfoRow).Text ' Question Stem
.Range("I" & MyDiagRow).Text = wsInfo.Range("C" & MyInfoRow).Text ' Question #
End With


End Sub


Thanks,

mdmackillop
03-31-2011, 02:11 PM
Set x = Application.InputBox("Select cell", Type:=8)

BTW you have undeclared variables. Are you really using Option Explicit?

mdmackillop
03-31-2011, 02:58 PM
What is MyDiagRow?

RonMcK
03-31-2011, 03:13 PM
I do? (Not surprised, I suppose) Well, yes this module has Option Explicit at the top.

I put the Input Box line of code in Move_Data since that's where I'm evaluating ActiveCell.


MyDiagRow? Well, please change MyRow in DIM and MyRow = 3 so they read MyDiagRow 'cause that's the wb/ws it's in/on.

Thanks,

mdmackillop
03-31-2011, 04:39 PM
In the copy you sent me, delete the temporary Row 1 and Column U from G4_Info

Try this version
Option Explicit

Public wbInfo As Workbook, wsInfo As Worksheet, FilenameInfo As String, LastInfoRow As Long
Public wbDiag As Workbook, wsDiag As Worksheet, FilenameDiag As String, LastDiagRow As Long
Public Grade As String, std As String, LastInfoCol As Long, LastDiagCol As Long
Public rngInfo As Range, rngDiag As Range, InfoCol As Long, DiagCol As Long
Public wb1 As Workbook, rng As Range, MyDiagRow As Long

Sub Find_Data()

' InfoFile = OpenFile("Info")
' DiagFile = OpenFile("Diag")

Grade = "G4"
Set wbInfo = Workbooks(Grade & "_INFO.xls")
Set wsInfo = wbInfo.Sheets("INFO")
With wsInfo
LastInfoRow = .UsedRange.Rows.Count
LastInfoCol = .UsedRange.Columns.Count
.Cells(2, 1).Resize(LastInfoRow, LastInfoCol).Interior.ColorIndex = xlNone
InfoCol = .Range("T1").Column
Grade = Left(.Range("B2").Text, 2)
Set rngInfo = .Range("A2").Resize(LastInfoRow, LastInfoCol) 'Column T
End With

Set wbDiag = Workbooks(Grade & " Diagnostic Assessment (2).xls")
Set wsDiag = wbDiag.Worksheets("DA - NL " & Grade)
With wsDiag
LastDiagRow = .UsedRange.Rows.Count
LastDiagCol = .UsedRange.Columns.Count
DiagCol = .Range("F1").Column
Set rngDiag = .Range("A3").Resize(LastDiagRow, LastDiagCol) 'Column F

' wsDiag has a list of unique Standards numbers; wsInfo has 1 or more instances of each Std code
' this next line gets a Std code for autofiltering the INFO list to show only lines w/ std codes
MyDiagRow = 3
Do While MyDiagRow <= LastDiagRow

If .Range("B" & MyDiagRow).Text = "" Then Exit Do
std = .Range("F" & MyDiagRow).Text
' std = "SC.4.P.10.1"


' Application.ScreenUpdating = False

With wsInfo
.Names.Add Name:="std", RefersToR1C1:="='[" & wbDiag.Name & "]DA - NL G4'!R3C6"
.Names("std").Comment = ""
'.Rows(1).Insert
.Columns("U").Insert
.Range("U1").Value = "Temp"
' LastInfoRow = .UsedRange.Rows.Count
Set rng = .Range("U2").Resize(LastInfoRow - 1)
rng.FormulaR1C1 = "=(RC[-1]=std)" ' ONLY WORKS IF 'std' IS DEFINED NAME
Set rng = .Range("U1").Resize(LastInfoRow)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not Move_Data Then
.Columns("U").Delete
Exit Sub '(MyDiagRow)
End If

.Columns("U").Delete
End With

' Application.ScreenUpdating = True

MyDiagRow = MyDiagRow + 1

Loop

End With

End Sub

Private Function Move_Data() As Boolean
Dim MyInfoRow As Long, x As Range
Move_Data = True
On Error Resume Next
Set x = Application.InputBox("Select cell", Title:="Pick a Row", Type:=8)
If x Is Nothing Then
Move_Data = False
Exit Function
End If
On Error GoTo 0

If ActiveCell.Worksheet.Name <> "INFO" Then Exit Function
If ActiveCell.Row > LastInfoRow Then Exit Function

MyInfoRow = x.Row
Cells(x.Row, 1).Resize(, 68).Interior.ColorIndex = 13
'What is this for?????
std = wsInfo.Range("T" & MyInfoRow).Value
' std = "SC.4.P.10.1"

With wsDiag
.Range("B" & MyDiagRow) = wsInfo.Range("B" & MyInfoRow) ' LO#
.Range("C" & MyDiagRow) = wsInfo.Range("E" & MyInfoRow) ' Short LO Code
.Range("I" & MyDiagRow) = wsInfo.Range("F" & MyInfoRow) ' Question Stem
.Range("G" & MyDiagRow) = wsInfo.Range("C" & MyInfoRow) ' Question #
End With


End Function

RonMcK
03-31-2011, 05:16 PM
MD,

Many thanks! That's working but it may have a bug. See my questions and observations inserted in the code, below, as comments.

MyDiagRow = 3
Do While MyDiagRow <= LastDiagRow
If .Range("B" & MyDiagRow).Text = "" Then Exit Do
std = .Range("F" & MyDiagRow).Text ' as an example: std = "SC.4.P.10.1"

'MD: We have a problem, here. We need to use the value in std (and do we need to change that
' variable name since we're using it also as the name of a cell?) to find an instance of the
' new std value (after iteration of MyDiagRow) R3C6 only works for SC.4.E.05.1. As the program
' loops, it keeps re-presenting the very first selection.
' Would it help if I defined col U3:U&LastInfoRow as a range and searched for the first instance
' of std to get the row number n to be used in RnC6, below, so we get a new selection matching
' the new std of each iteration?
' Does the color bar remain (persist) between iterations so the user has a graphic picture in
' INFO.xls of all the questions selected for the diagnostic assessment?
' Application.ScreenUpdating = False
With wsInfo
.Names.Add Name:="std", RefersToR1C1:="='[" & wbDiag.Name & "]DA - NL G4'!R3C6"
.Names("std").Comment = ""
'.Rows(1).Insert
.Columns("U").Insert
.Range("U1").Value = "Temp"


Thanks,

RonMcK
03-31-2011, 05:47 PM
MD,

So, here's what I thought of to solve the problem:

MyDiagRow = 3
Do While MyDiagRow <= LastDiagRow
If .Range("B" & MyDiagRow).Text = "" Then Exit Do ' I don't want to exit, I want to skip to the bottom of the loop, increment MyDIagRow and loop back.
std = .Range("F" & MyDiagRow).Text ' as an example: std = "SC.4.P.10.1"
With wsInfo
Set SrchRng = .Range("U2").Resize(LastInfoRow)
TargetRow = SrchRng.Find(std, xlNext).Row ' have err91 Obj var or With Block var not set
.Names.Add Name:="std", RefersToR1C1:="='[" & wbDiag.Name & "]DA - NL G4'!R" & _
TargetRow & "C6"
' .Names.Add Name:="std", RefersToR1C1:="='[" & wbDiag.Name & "]DA - NL G4'!R3C6"
.Names("std").Comment = ""
'.Rows(1).Insert
.Columns("U").Insert
.Range("U1").Value = "Temp"


And a new question. How does the Move_Data function get invoked? I see where the return value is tested and the temp column ("U") removed. And when I run Find_Data, I see the InputBox open, so, it's happening, somehow.

RonMcK
03-31-2011, 07:39 PM
MD,

For the moment, I've changed the IF-THEN logic, as follows:

MyDiagRow = 3
Do While MyDiagRow <= LastDiagRow
If .Range("B" & MyDiagRow).Text <> "" Then
GoTo Next_Loop
End If
std = .Range("F" & MyDiagRow).Text ' as an example: std = "SC.4.P.10.1"
.
.
.
End With
Next_Loop:
MyDiagRow = MyDiagRow + 1
Loop
End With
End Sub

mdmackillop
04-01-2011, 05:53 AM
Sub Find_Data()
' InfoFile = OpenFile("Info")
' DiagFile = OpenFile("Diag")
Dim stdX As Long
stdX = 2
Grade = "G4"
Set wbInfo = Workbooks(Grade & "_INFO.xls")
Set wsInfo = wbInfo.Sheets("INFO")
With wsInfo
LastInfoRow = .UsedRange.Rows.Count
LastInfoCol = .UsedRange.Columns.Count
.Cells(2, 1).Resize(LastInfoRow, LastInfoCol).Interior.ColorIndex = xlNone
InfoCol = .Range("T1").Column
Grade = Left(.Range("B2").Text, 2)
Set rngInfo = .Range("A2").Resize(LastInfoRow, LastInfoCol) 'Column T
End With
Set wbDiag = Workbooks(Grade & " Diagnostic Assessment (2).xls")
Set wsDiag = wbDiag.Worksheets("DA - NL " & Grade)
With wsDiag
LastDiagRow = .UsedRange.Rows.Count
LastDiagCol = .UsedRange.Columns.Count
DiagCol = .Range("F1").Column
Set rngDiag = .Range("A3").Resize(LastDiagRow, LastDiagCol) 'Column F
' wsDiag has a list of unique Standards numbers; wsInfo has 1 or more instances of each Std code
' this next line gets a Std code for autofiltering the INFO list to show only lines w/ std codes
MyDiagRow = 3
Do While MyDiagRow <= LastDiagRow
If .Range("B" & MyDiagRow).Text = "" Then ' Exit Do
std = .Range("F" & MyDiagRow).Text
' std = "SC.4.P.10.1"
' Application.ScreenUpdating = False
With wsInfo
'Get new Std on each loop
stdX = stdX + 1
.Names.Add Name:="std", RefersToR1C1:="='[" & wbDiag.Name & "]DA - NL G4'!R" & stdX & "C6"
'.Names("std").Comment = ""
'.Rows(1).Insert
.Columns("U").Insert
.Range("U1").Value = "Temp"
'LastInfoRow = .UsedRange.Rows.Count
Set rng = .Range("U2").Resize(LastInfoRow - 1)
rng.FormulaR1C1 = "=(RC[-1]=std)" ' ONLY WORKS IF 'std' IS DEFINED NAME
Set rng = .Range("U1").Resize(LastInfoRow)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Move_Data Then
.Columns("U").Delete
Exit Sub '(MyDiagRow)
End If
.Columns("U").Delete
End With
' Application.ScreenUpdating = True
End If
MyDiagRow = MyDiagRow + 1
Loop
End With
End Sub

RonMcK
04-01-2011, 07:09 AM
Many thanks, Malcolm. I woke up this morning with the realization that #9 & #10, above, were way off base and that what was needed was the value of MyDiagRow (or stdX) in place of R3 in R3C6. Much simpler.

Does simply testing the return value of the Move_Data function in the IF-THEN statement invoke it and run it? RJM: from stepping the code: Yes.

Again, thanks!!

RonMcK
04-01-2011, 07:41 AM
MD,

I'm confused.
1. When I run the code, the Select a Cell dialog displays over wsDiag and not wsInfo (the source of data to be pasted into wsDiag).
RJM: Perhaps, this is a place where I need to use the accursed Activiate method?
2. If I select a cell on wsDiag (wrong sheet but only one 'available') the code detects that it's the wrong sheet and loops back to the dialog, creating a locked loop of sorts).
3. Pressing Cancel bails me out of the Sub, as expected.
4. The Move_Data function is accessed from within a WITH wsInfo block, so, how do we get wsInfo to display instead of wsDiag?

5. Why does StdX start with 2? Isn't the first data cell of wsDiag on row 3? RJM: DOH! You increment before using, so StdX=3 the first time it's used.

RonMcK
04-01-2011, 09:30 AM
MD,

I think we have it. I did some debugging and here is what I found:

1. I found that Name Manager showed 2 different Refers To values for 'std', so I deleted both of them.
2. Next, to help remind me (and the user) where we should be in the list, I passed the variable std to Move_Data and added displaying it to the title for InputBox.
3. I found that the code was displaying the very first standard on wsDiag as the selected range, even though the InputBox dialog displayed a standard that is much nearer the end of the list and really is the next one to be moved to wsDiag.
4. The problem was that stdX was not getting incremented for all those lines in wsDiag that had already been fillled in, even though the IF-THEN at the top was incrementing MyDiagRow.
5. I moved incrementing stdX to just above the Loop but discovered that the program was then displaying data for the standard before the blank wsDiag line the InputBox thinks we should fill-in.
6. I changed the counter in the .Names.Add line from stdX to MyDiagRow and it now works as it should.

I finished filling out the wsDiag worksheet in a matter of moments.

Huzzah!!

Many thanks for your expert assistance in sorting me out.

Here is the final code:
Option Explicit
Public wbInfo As Workbook, wsInfo As Worksheet, FilenameInfo As String, LastInfoRow As Long
Public wbDiag As Workbook, wsDiag As Worksheet, FilenameDiag As String, LastDiagRow As Long
Public Grade As String, std As String, LastInfoCol As Long, LastDiagCol As Long
Public rngInfo As Range, rngDiag As Range, InfoCol As Long, DiagCol As Long
Public wb1 As Workbook, rng As Range, MyDiagRow As Long, SrchRng As Range, TargetRow As Long
Sub Find_Data()
' InfoFile = OpenFile("Info")
' DiagFile = OpenFile("Diag")
Dim stdX As Long
stdX = 2
Grade = "G4"
Set wbInfo = Workbooks(Grade & "_INFO.xls")
Set wsInfo = wbInfo.Sheets("INFO")
With wsInfo
LastInfoRow = .UsedRange.Rows.Count
LastInfoCol = .UsedRange.Columns.Count
.Cells(2, 1).Resize(LastInfoRow, LastInfoCol).Interior.ColorIndex = xlNone
InfoCol = .Range("T1").Column
Grade = Left(.Range("B2").Text, 2)
Set rngInfo = .Range("A2").Resize(LastInfoRow, LastInfoCol) 'Column T
End With
Set wbDiag = Workbooks(Grade & " Diagnostic Assessment (2).xls")
Set wsDiag = wbDiag.Worksheets("DA - NL " & Grade)
With wsDiag
LastDiagRow = .UsedRange.Rows.Count
LastDiagCol = .UsedRange.Columns.Count
DiagCol = .Range("F1").Column
Set rngDiag = .Range("A3").Resize(LastDiagRow, LastDiagCol) 'Column F
' wsDiag has a list of unique Standards numbers; wsInfo has 1 or more instances of each Std code
' this next line gets a Std code for autofiltering the INFO list to show only lines w/ std codes
MyDiagRow = 3
Do While MyDiagRow <= LastDiagRow
If .Range("B" & MyDiagRow).Text = "" Then ' Exit Do
std = .Range("F" & MyDiagRow).Text
' std = "SC.4.P.10.1"
' Application.ScreenUpdating = False
With wsInfo
'Get new Std on each loop
' rjm: moved StdX increment to just before loop so it changes as we pass up filled in rows in wsDiag
' rjm: changed to using MyDiagRow instead of stdX since it has the value we need in the next line
.Names.Add Name:="std", RefersToR1C1:="='[" & wbDiag.Name & "]DA - NL G4'!R" & MyDiagRow & "C6"
'.Names("std").Comment = ""
'.Rows(1).Insert
.Columns("U").Insert
.Range("U1").Value = "Temp"
'LastInfoRow = .UsedRange.Rows.Count
Set rng = .Range("U2").Resize(LastInfoRow - 1)
rng.FormulaR1C1 = "=(RC[-1]=std)" ' ONLY WORKS IF 'std' IS DEFINED NAME
Set rng = .Range("U1").Resize(LastInfoRow)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Move_Data(std) Then
.Columns("U").Delete
Exit Sub '(MyDiagRow)
End If
.Columns("U").Delete
End With
' Application.ScreenUpdating = True
End If
MyDiagRow = MyDiagRow + 1
stdX = stdX + 1
Loop
End With
End Sub
Private Function Move_Data(std As String) As Boolean
Dim MyInfoRow As Long, x As Range
Move_Data = True
On Error Resume Next
' wsInfo.Activate
Set x = Application.InputBox("Select cell", Title:="Pick a Row for std: " & std, Type:=8)
If x Is Nothing Then
Move_Data = False
Exit Function
End If
On Error GoTo 0
If ActiveCell.Worksheet.Name <> "INFO" Then Exit Function
If ActiveCell.Row > LastInfoRow Then Exit Function
MyInfoRow = x.Row
Cells(x.Row, 1).Resize(, 68).Interior.ColorIndex = 13
With wsDiag
.Range("B" & MyDiagRow) = wsInfo.Range("B" & MyInfoRow) ' LO#
.Range("C" & MyDiagRow) = wsInfo.Range("E" & MyInfoRow) ' Short LO Code
.Range("I" & MyDiagRow) = wsInfo.Range("F" & MyInfoRow) ' Question Stem
.Range("G" & MyDiagRow) = wsInfo.Range("C" & MyInfoRow) ' Question #
End With
End Function



Thanks, again,

mdmackillop
04-01-2011, 10:06 AM
Glad you're fixed. I had never really worked out the full logic of the code and was just fixing the errors to get it running (I forgot to mention the two Std names.
Some things to consider:
I would change your Std variable to something else, not that it fails, but it gets confused with the range name. Another small tweak would be to remove the repeated insertion/deletion of Column U. It's a bit clumsy.
You might also wish to split your main code into smaller units, even 2 of them, for better understanding/ease of maintenance.

Whilst you remember everything that is happening, you should comment your code well. In 6 months time, things will not be so obvious.

RonMcK
04-01-2011, 10:18 AM
Glad you're fixed. I had never really worked out the full logic of the code and was just fixing the errors to get it running (I forgot to mention the two Std names.
Some things to consider:
I would change your Std variable to something else, not that it fails, but it gets confused with the range name. Another small tweak would be to remove the repeated insertion/deletion of Column U. It's a bit clumsy.
You might also wish to split your main code into smaller units, even 2 of them, for better understanding/ease of maintenance.

Whilst you remember everything that is happening, you should comment your code well. In 6 months time, things will not be so obvious.

Malcolm,

I understand the difficulties inherent in working with someone else's code, I did that for 6 years on a Help Desk. The challenge was taking care to be sure the current patch didn't produce untoward unintended consequences that resulted in more calls to the Help Desk.

Way back in the beginning of the thread, I threatened to break this into manageable chuncks once it was running. And, yes, I'll give std, the variable, a new name. I'll get on with doing those things.

Documenting is critical; I don't have to wait 6 months to wonder what the heck I was thinking when I wrote some code. Senior moments and brain fades are a fact of life anymore.

I'll email you the completed project with enhanced documentation.

Thanks, again!

RonMcK
06-03-2011, 07:09 PM
Malcolm,

I have a new puzzle and it seems to involve the following function, in particular, the 3 range assignment. In a number of cases the result of the assignment is the new cell contains "#VALUE" instead of the text.

Private Function Move_Data(std As String) As Boolean

snip------
With wsDiag
.Range("B" & MyDiagRow) = wsInfo.Range("B" & MyInfoRow) ' LO#
.Range("C" & MyDiagRow) = wsInfo.Range("E" & MyInfoRow) ' Short LO Code
.Range("I" & MyDiagRow) = wsInfo.Range("F" & MyInfoRow) ' Question Stem
.Range("G" & MyDiagRow) = wsInfo.Range("C" & MyInfoRow) ' Question #
End With
End Function

At first, I thought the problem was that there was more text in the source cell than Excel can write to the target cell. But, then, I noticed that the program had no trouble moving the largest text block (934 char) that I saw in a quick visual scan of the source worksheet. So, I'm flummoxed. And, a further so, look for a zip file in your mail box with all three files, the program, source and target w/ some data include these hiccups.

I'd appreciate another pair of eyes looking at it.

Edited in at 2300 EST: Strange, I'm unable to replicate this behavior on XL2007 on my PC laptop; both the user and I observed the behavior on the Mac OS X machines at the office, his MacBook Pro and my Mac Pro, each running XL2004. I suspect i better consult with mikerickson and see what he might suggest. I'll send you a copy of the files anyway.

Thanks,